AccessVBAで特定の文字を含むフォルダを開く

前へ 次へ
このQ&Aのポイント
  • Accessのフォームにテキストボックスを設置し、ボタンをクリックすると、そのテキストボックスに入力されている言葉を含むフォルダを開く方法を教えてください。
  • Accessフォームで顧客名簿を作成し、サーバー上に顧客名ごと名前のついたフォルダがあります。Dir関数を使用して、テキストボックスに入力された文字を含むフォルダが存在するかどうかを判定し、メッセージボックスで表示することはできました。しかし、そのフォルダを開く方法がわかりません。フルパスを取得するための方法や、Dir関数の使用方法についてアドバイスをいただけますか？
  • AccessVBAを使用して、特定の文字を含むフォルダを開く方法を教えてください。テキストボックスに入力された文字をDir関数を使って検索し、フォルダの存在を判定することはできましたが、フルパスを取得する方法がわかりません。どのようにすればフォルダのフルパスを取得できるのでしょうか？
回答を見る
  • ベストアンサー

AccessVBAで特定の文字を含むフォルダを開く

Accessのフォームにテキストボックスを設置し、 ボタンをクリックすると、 そのテキストボックスに入力されている言葉を含むフォルダを開きたいです。 Accessフォームで顧客名簿を作成していて、 サーバー上に顧客名ごと名前のついたフォルダがあります。 Dir関数を使って、 テキストボックスに「山田花子」と入力してボタンクリックすると、 「山田花子」を含むフォルダが存在するかどうかを メッセージボックスで知らせる、というところまではうまくできました。 コードは以下です。 Dim MyPath, MyFullPath MyPath = "\\×××\×××\×××\" MyFullPath = Dir(MyPath & "*" & [テキストボックス] & "*", vbDirectory) If MyFullPath = "" Then MsgBox "存在しません" Else MsgBox "存在します" End If End Sub この先、存在するならばそのフォルダを開くようにしたいです。 どうにかしてそのフォルダのフルパスを取得したいのですが その方法がわかりません。 そもそもDir関数は必要なかったのか・・・そのへんもよくわかりません。 ご教授お願いいたします！

質問者が選んだベストアンサー

  • ベストアンサー
  • ap_2
  • ベストアンサー率64% (70/109)
回答No.1

Dirの戻り値が見つかったフォルダ名なので、こーかな・・ 　MyDirPath = Dir(...略...) 　MyFullPath = MyPath & MyDirPath フォルダを開くって、エクスプローラー(ウィンドウ)で、かな？ 　Shell "C:\Windows\Explorer.exe " & MyFullPath, vbNormalFocus エクスプローラーはフォルダ管理ツール＝独立したプログラムなので、 外部プログラムを実行するShellを使えばいいです。 http://officetanaka.net/excel/vba/function/Shell.htm

masunona
質問者

お礼

大変遅くなってしまって誠に申し訳ありません。 回答を拝見し、さっそくためしてみて大成功しました！ 上司にもとてもほめられてうれしかったです～！ そのまま浮かれてお礼するのを忘れていました。最低です。 本当にありがとうございました！

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • フォルダー名に特殊文字？が存在する場合にエラー発生

    以下のコードでフォルダー名を取得しています。 しかし、フォルダー名に特殊文字？が存在する場合に下記でエラーが発生します。 　例えば「Oxygène」　でeの上に’があるなど 　　If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then 　　　　　実行エラー　53：　ファイルが見つかりません。 これは、excelの仕様で処理できないのでしょうか　？ 他のコードで処理できれば教えて下さい。 --------------------------------------- Sub フォルダ名取得() Dim MyName Dim MyPath Dim i As Long ’仮の消込（初期化：　前回の記入文をクリアー） Range("A5:H50").Clear i = 1 ' フォルダーを自由に選べること。 参考：officeTANAKA With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then ' MsgBox .SelectedItems(1) If Len(.SelectedItems(1)) = 3 Then ' c:\の場合とサブフォルダーの場合 MyPath = .SelectedItems(1) Else MyPath = .SelectedItems(1) & "\" End If End If End With If MyPath = Empty Then MsgBox "フォルダー名表示をキャンセルしました。": Exit Sub 'Range("b2:c2").ShrinkToFit = True '　縮小してセル内に表示 MyName = Dir(MyPath, vbDirectory) ' 最初のフォルダ名を返します。 '親フォルダー Range("A2") = MyPath Do While MyName <> "" ' ループを開始します。 ' 現在のフォルダと親フォルダは無視します。 If MyName <> "." And MyName <> ".." Then ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。 If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then Range("a" & i + 4) = MyPath & MyName ' アクティブシートA5セルから下方にフルパス表示。 Range("b" & i + 4) = MyName ' アクティブシートB5セルから下方にフォルダ名表示 i = i + 1 End If End If MyName = Dir ' 次のフォルダ名を返します。 Loop MsgBox MyPath & "の中にフォルダーは" & (i - 1) & "個のフォルダーがありました。" End Sub

  • 特定の文字だけ太文字にするには・・

    簡易チャット作ってます。発言者の名前の部分だけ太文字にしようとしてい ます。 テキストボックス２に文を書いてエンターを押すとテキストボックス１に書 花子：～～～　　と書き込まれるようにはできました。花子の部分 だけふと文字にするには？？ Private Sub Text2_KeyPress(KeyAscii As Integer) If (KeyAscii = 13) Then Text1.Text = Text1.Text + "花子：" + Text2.Text + vbCrLf Text2.Text = "" KeyAscii = 0 End If End Sub

  • エクセル（ＶＢＡ）でファイル名（サブフォルダ含む）、更新日時を表示させたい

    エクセルのＶＢＡであるフォルダ以下の全てのファイル名と更新時間をエクセルシート上に表示させたく、以下のプログラムを作成したのですが 、サブフォルダ内のファイルを表示させることができません。何か良い方法がありましたら教えていただけないでしょうか？宜しくお願いいたします。 Sub SAMPLE() Dim serchPass As String j = 1 Mypath = "C:\My Documents\" MyName = Dir(Mypath, vbDirectory) Do While MyName <> "" ' ループを開始します。 ' 現在のフォルダと親フォルダは無視します。 If MyName <> "." And MyName <> ".." Then ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。 If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then Debug.Print MyName ' フォルダであれば、それを表示します。 Else: GoTo 10 End If serchPass = Mypath & MyName With Application.FileSearch .NewSearch .LookIn = serchPass If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i + j, 1).Value = .FoundFiles(i) Cells(i + j, 3) = FileDateTime(.FoundFiles(i)) Next i j = i + j End If End With 10 End If 　　 MyName = Dir ' 次のフォルダ名を返します。 Loop End Sub

  • DIR関数について教えてください。

    現在、テキストボックスに入力した文字が、テキストファイル等の中身に存在するかを調べるプログラムの問題を解いているのですが。 選択したフォルダの下の階層にある全てのフォルダに対しても 検索を行うプログラミングでかなり悩んでいます。 特に、Dir関数の意味が？？？です。 例えば現在のパスをC:\テスト01\テスト02\としたときに、 変数Mypathに Mypath=C:\テスト01\テスト02\と代入して、 変数MyNameに MyName = Dir(setPath & "*.*", vbDirectory)とすると 変数MyNameには、１回目は"."が入り、２日目は".."が入ります。 なぜ、"."や".."が入るのか分からず悩んでいます。 "."は、現在のフォルダを表して、".."は親（1つ上）のフォルダを表していると、 と言うことは、ヘルプを調べて分かったのですが。 なぜ？こういった値が入るのか理解できない状態です。 ３回目は、まともなファイル名が（例えばtest.txt）などのちゃんとした ファイル名が入ってくれるのですが。 特に、".."（親フォルダ）をなぜ見に行くのか？？よく分かっていません。 良かったら教えてください。 よろしくお願いします。m(__)m

  • フォルダの中身が空白なのかを調べたい。

    こんばんは。 エクセル2003のvbaにて Sub test() If Dir("D:新しいフォルダ") = "" Then MsgBox "フォルダには何も入っていません" Else MsgBox "フォルダに何か入っています" End If End Sub で試してみたのですが フォルダに何か入っていても "フォルダには何も入っていません" と表示されてしまいます。 どうすればうまくいくのでしょうか？ よろしくお願いします。

  • フォルダーとファイルの認識

    フォルダーとファイルを認識するため、 例として下記のVBAを実行します。 If (GetAttr("D:\winpobox-0.1\win2000") And vbDirectory) = vbDirectory Then MsgBox "フォルダ。" Else MsgBox "ファイル。" End If 結果は、「フォルダ」となりますが、 「win2000」が「win.2000」とwinと2000の間に「.」（ドット）が入ると「ファイルが見つかりません。」となります。 フォルダー名にドットが入っても識別できる方法はありますか。 よろしくお願いいたします。

  • エクセルでフォルダまたはファイルを開くマクロですが、どのように改良すれ

    エクセルでフォルダまたはファイルを開くマクロですが、どのように改良すればよろしいでしょうか？ 下記マクロは、エクセルシートのJ列のあるセルをダブルクリックすると、そのセルに記入された文字列を検索して、該当のフォルダまたは、写真が開きます。（エクセルファイルと写真は同フォルダに保存している場合のみ有効） 困っていることは、J列のセルと該当フォルダまたは、写真ファイルをリンクさせたいのですが、文字列が全て一致している時のみしか開かないことです。 D<デジカメ<商品名フォルダ＜写真ファイル 例えば　セルＪ3の文字列がABCEで、フォルダ名またはファイル名がABCDEFであった場合、文字列ABCEを含む条件で、フォルダ名またはファイル名ABCDEFを開くように改良したいのですが、 また、エクセルファイルと写真ファイルの保存場所は、全く違うフォルダにしたいのですが、 エクセルファイルと写真ファイルは、別フォルダの場合、どのように検索先フォルダのパスを入れたら良いのでしょうか？ マクロに詳しい方ご教授下さい。よろしくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myPath As String If Target.Cells(1, 1).Column <> 10 Then Exit Sub Cancel = True myPath = ThisWorkbook.Path & "\" & Target.Cells(1, 1).Text If Dir(myPath, vbDirectory) <> "" Then Shell "explorer.exe /e,/root," & myPath, vbNormalFocus Exit Sub End If myPath = Replace(LCase(myPath), ".jpg", "\" & Target.Cells(1, 1).Text) If Dir(myPath, vbNormal) <> "" Then Shell "rundll32.exe shimgvw.dll,ImageView_Fullscreen " & myPath, vbNormalFocus End If End Sub

  • 特定の名前のシートがあるか確認するには

    1つのフォルダの中に ４つのエクセルファイルがあります。 そのエクセルファイルの中に12というファイル名がある場合は メッセージを出したいと考えて以下のコードを書きました。 この４つのファイルのうち1つのファイルに12のシートを 存在させてみて、以下のコードで実行しました。 Sub シートの確認2() Const MyPath As String = "C:\test\" Dim MyBook As Workbook Dim MyFileName As String Dim MyRng As Range Dim i As Long Dim ws As Worksheet, flag As Boolean MyFileName = Dir(MyPath & "*.xlsx") Do While MyFileName <> "" If ThisWorkbook.Name <> MyFileName Then Set MyBook = Workbooks.Open(MyPath & MyFileName) For i = 1 To Worksheets.Count If Worksheets(i).Name <> "12" Then MsgBox "[12]シートが存在しません。" Else MsgBox "[12]シートが存在します。" End If Next i MyBook.Close End If MyFileName = Dir() Loop End Sub すると、 12という名前のあるシートを持つブックの場合、 "[12]シートが存在しません。" "[12]シートが存在します。" の両方のメッセージが出てきます。 おそらく考えるに そのブックにはシートが２枚あり、 そのうち１つが12という名前のシートであり もう一つは違う名前なので このような現象が出てくるのではないかと。 ただ単純に、その同一フォルダ内のブックに12というがあるかないかを 取得するにはどうしたらよいでしょうか？

  • Dir関数について

    MyPath = "c:\test\" MyName = Dir(MyPath, vbDirectory) Do While MyName <> "" If MyName <> "." And MyName <> ".." Then Debug.Print MyName End If MyName = Dir Loop ------------------------------------------------- いきなりコーディングを紹介しましたが、 上記だと"C:\test\"の直下のファイル・フォルダしかデバッグアウトされませんが、 "C:\test\sample"のように、"C:\test\"配下にまだフォルダがあり、 それらを表示させるにはどのようにしたらよろしいでしょうか？ 大変見づらくて申し訳ありませんが、宜しくお願い致します。

  • VBA　探しているFileがないときの処理方法

    現在、下記のようにしてマクロ実行ブックと同じ階層のフォルダ名を取得してAに、フォルダ内のabc.XLSのC9の値をBに、abc.XLSの更新日時をCに表示させています。 このとき、フォルダ内にabc.XLSが無い場合にファイル名をAに書き出してB及びCは空白というように表示したいのですが、どのようにすればよろしいでしょうか。 macro1は以前質問させて頂いたものがベースになっています。ExecuteExcel4Macroを使っている関係でファイル名が無いときの処理はDirを使ってできるとmougで調べてわかりましたが、自分の知識ではできず、macro2を作成したのですが、指定ファイルがない場合の処理がうまくできずにいます。 macro1はファイルオープンの窓が開きます。macro2はファイルが存在しないという窓が開きます。 どちらの場合でもかまいませんのでお力をお貸し頂けませんでしょうか。 Sub macro1() Dim myPath As String Dim myFolder As String Dim r As Long r = 3 myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" Application.ScreenUpdating = False Range("A3:C60").Clear Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Cells(r, 1) = myFolder Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[" & myBook & "]Sheet1 '!R9C3") On Error Resume Next Cells(r, 3) = FileDateTime(myPath & myFolder & "\" & myBook) On Error GoTo 0 If Cells(r, 3) = "" Then Cells(r, 2) = "myBook" End If Cells(r, 2).NumberFormatLocal = "#,##0_ " Cells(r, 3).NumberFormatLocal = "y""年""m""月""" With Range("A3:C60") .Sort Key1:=Range("C3"), Order1:=xlAscending .Borders.LineStyle = True End With r = r + 1 End If End If myFolder = Dir() Loop Application.ScreenUpdating = True End Sub Sub Macro2() Dim myPath As String Dim myFolder As String Dim myBook As String myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" i = 2 Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Workbooks.Open (myPath & myFolder & "\" & myBook) Range("C9").Activate Selection.Copy ThisWorkbook.Activate Cells(i, 1) = myFolder Cells(i, 2).PasteSpecial xlValues Cells(i, 3) = FileDateTime(myPath & myFolder & "\" & myBook) Workbooks(myBook).Close SaveChanges:=False i = i + 1 End If End If myFolder = Dir() Loop End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する