2013年8月16日金曜日

全部のフォルダからpickup

前回のは、あらかじめ特定のフォルダに、到達確認ファイルをsetしておき、問い合わせ番号等を自動で取得するものであった。

この 「あらかじめset」が実に バカバカしい作業で、 それならと つくりかえたのがコレ。

全フォルダを対象に「到達確認ファイル」を検索し、エクセルシートへ、フォルダ名とともにリストを作成するもの。手作業工程を極力除去したものだ。

特定フォルダのみであれば Dir関数で用が足りるが、すべてのフォルダ(指定したドライブのすべてのフォルダ)を対象としたいのであれば、次でないとイカンようだ。

Sub FolderSearch(strTargetDir As String)
  Dim fso As Object
  Dim folder As Object
  Dim subfolder As Object
  Dim file As Object
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set folder = fso.GetFolder(strTargetDir)
 
  Sheets("格納シート").Select
 
  For Each subfolder In folder.SubFolders
    FolderSearch subfolder.Path
  Next subfolder
 
 
  For Each file In folder.Files
    With file
    If Right(.Name, 4) = "html" And Mid(.Name, 1, 14) = "totatsukakunin" Then
        cnt = cnt + 1
    Cells(cnt, 1) =mid( .Path,1,instr(.Path,"totatsu")-1)
        Cells(cnt, 2) = .Name
     
    Else
        dumy = ""
    End If
    End With
  Next file
End Sub

これを 次の形式で呼び出せばいい。
エクセルの書き込み行を cntとして計算しているが、再帰的呼び出しのためか
public宣言しておかないとダメです。

Public cnt As long

Sub  全フォルダ読み込み()
  Sheets("格納シート").Select
  cells(1,1)="Path name"
  cells(1,2)="到達確認ファイル名"
  cells(1,3)="到達番号"
  cells(1,4)="問い合わせ番号"

  cnt=1

  FolderSearch   "c:\"  ’  ん? yenマークがでないゾ

End Sub




0 件のコメント:

コメントを投稿