Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1298 / 13644 ツリー ←次へ | 前へ→

【75200】部分一致で検索してファイルを開く 14/1/7(火) 15:23 質問[未読]
【75205】Re:部分一致で検索してファイルを開く kanabun 14/1/7(火) 17:45 発言[未読]
【75208】Re:部分一致で検索してファイルを開く 14/1/8(水) 8:59 お礼[未読]

【75200】部分一致で検索してファイルを開く
質問    - 14/1/7(火) 15:23 -

引用なし
パスワード
   VBAでファイルを検索して開く際に、部分一致でファイルを探してきて開くことは可能なのでしょうか。

パスとファイル名を指定して開くVBAならできたのですが・・・
指定せずに、検索して部分一致で探したいんです。

【75205】Re:部分一致で検索してファイルを開く
発言  kanabun  - 14/1/7(火) 17:45 -

引用なし
パスワード
   ▼r さん:
>VBAでファイルを検索して開く際に、部分一致でファイルを探してきて開くことは可能なのでしょうか。
>部分一致で探したいんです。

検索パターンを指定して、検索フォルダを指定し、
ヒットしたファイルを表示するコード例です。

Sub Try1()
 Call SearchFile("abc*.csv")  '検索パターン
End Sub

Private Sub SearchFile(Filename As String)
 Dim myFolder As String
 '検索のトップフォルダをダイアログで指定
  Dim oFolder As Object
  Const BIF_RETURNNONLYFSDIRS = &H1  'ディレクトリのみ選択可
  Const BIF_EDITBOX = &H10      'アイテム名入力用のEdit_boxを表示
  Dim hWnd As Long
  
  hWnd = Application.hWnd
  With CreateObject("Shell.Application")
   Set oFolder = .BrowseForFolder(hWnd, _
         "フォルダを選択して下さい", _
         BIF_RETURNNONLYFSDIRS Or BIF_EDITBOX, _
         CreateObject("WScript.Shell").SpecialFolders("DeskTop"))
   If (oFolder Is Nothing) Then Exit Sub
   myFolder = oFolder.Self.Path
  End With
  If Right$(myFolder, 1) <> "\" Then myFolder = myFolder & "\"
 
 'サブフォルダを含むファイルのワイルドカード検索
  Dim FoundFiles() As String
  Dim tmpPath As String
  Dim sCmd As String
  Dim ko As Long
  
  '---- Dirコマンドによるサブフォルダを含むファイル名の検索
  Filename = myFolder & Filename
  tmpPath = Environ$("Temp") & "\Dir.tmp" '一時ファイルパス

  sCmd = "DIR """ & Filename & """ /b/s/a:-D > """ & tmpPath & """"
           '' /b ファイル名のみ
           '' /s サブディレクトリも検索
           '' /a:-D サブディレクトリー名は表示しない

  With CreateObject("WScript.Shell")
    ko = .Run("CMD /C " & sCmd, 7, True) 'Dirコマンド実行
  End With
  If ko Then
    MsgBox "ファイルの検索に失敗しました", , Filename
    Exit Sub
  End If
  If FileLen(tmpPath) < 2 Then Exit Sub 'ファイルが見つからなかった

  '----- Dirコマンドで取得したファイル名を配列に格納
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open tmpPath For Binary As io
   ReDim buf(1 To LOF(io))
   Get #io, , buf
  Close io
  Kill tmpPath
  FoundFiles() = Split(StrConv(buf, vbUnicode), vbCrLf)
  ko = UBound(FoundFiles)
  ReDim Preserve FoundFiles(ko - 1)
  MsgBox ko & "個のファイルがみつかりました" & vbCr _
   & Join(FoundFiles(), vbCr)
End Sub


ヒットしたファイルは複数あるかもしれないので、とりあえずMsgBoxに
表示しています。

【75208】Re:部分一致で検索してファイルを開く
お礼    - 14/1/8(水) 8:59 -

引用なし
パスワード
   おはようございます。

大変細かいコードまで書いてくださって・・・ありがとうございます。
一度このコードをもとにやってみます。
わからなかったら、またご質問させていただくかもしれませんが、その時は宜しくお願いします。

1298 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free