
筆箱にVBAのカンニングペーパーを入れる係のみすくです。こんにちは。

Excelのシート上に、
格納先のファイルパスとワイルドカードを使った条件を書いておいて、
条件にマッチしたらフォルダに格納。
MSDNのリファレンスによると、
「注釈: Microsoft Windows では、Dir で複数の文字 ( \* ) と 1 文字 ( ?) のワイルドカードを使用して、複数のファイルを指定できます。Macintosh では、これらの文字は有効なファイル名の文字と見なされ、複数のファイルを指定するためのワイルドカードとしては使用できません。」
Public Sub main()
    copyFilesByRule ("D:\Test\src")
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】ファイルをコピー
'【処理概要】Excelシートに記載したパスにファイルをコピー
'【引    数】[I]ByVal targetDir As String コピー元ファイルのあるディレクトリパス
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub copyFilesByRule(ByVal targetDir As String)
    Dim sh As Worksheet      'ワークシートオブジェクト
    Dim arr As Variant       '作業領域配列
    Dim index As Long        'カウンタ
    Dim endRowIndex As Long  '最終行
    Dim fileName As String   'ファイル名
    Dim oFso As New FileSystemObject 'ファイルシステムオブジェクト
    
    targetDir = AddPathSeparator(targetDir)
    
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    '末尾行
    endRowIndex = sh.Cells(Rows.Count, "A").End(xlUp).Row
    '配列に格納
    arr = sh.Range(sh.Cells(2, eCOL.COL_DIRECTORY), sh.Cells(endRowIndex, eCOL.COL_RULE))
    'ファイルをコピー
    For index = 1 To UBound(arr)
        fileName = Dir(targetDir & arr(index, eCOL.COL_RULE))
        Do While Len(fileName) > 0
            oFso.copyFile targetDir & fileName, AddPathSeparator(arr(index, eCOL.COL_DIRECTORY)), True
            fileName = Dir()
        Loop
    Next index
    
    Set sh = Nothing
    Set oFso = Nothing
End Sub
'---------------------------------------------------------------------------------------------------
'【処 理 名】ディレクトリパスへのセパレータ付与
'【処理概要】ディレクトリパスの末尾にセパレータがなければ付与する
'【引    数】[I]ByVal path As String ディレクトリパス
'【返 却 値】 なし
'---------------------------------------------------------------------------------------------------
Public Function AddPathSeparator(ByVal path As String) As String
    If Right(path, 1) <> ChrW(92) Then
        path = path & ChrW(92)
    End If
    AddPathSeparator = path
End Function
		
			参考
			あまり知られていないDir関数の特徴moug
		
		
			参考
			Dir 関数msdn
		
最近のコメント





コメントを残す