実現したいこと
- 目的のファイルを格納するサブフォルダを検索する。
- 目的のファイルを指定フォルダへコピーする。
- コピーするファイルはファイル名を特定の形式に変更する。
工程分解
- 親フォルダのフルパス、コピー先フォルダのフルパス、サブフォルダの検索条件を指定する。
- 親フォルダからサブフォルダと目的のファイルを検索する。
- ファイル名を変更する。
- 指定フォルダに目的のファイルをコピー&ペーストする。
Sub CopyAndRenameFile()
Dim ParentFolderPath, FolderPathFrom, FolderPathTo
Dim FileName1, FileName2
Dim Arr1() As String, Arr2() As String
Dim FilePathFrom, FilePathTo
Dim FSO, SFs, SF, SFName, TFN
ParentFolderPath = Range("A2")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SFs = FSO.GetFolder(ParentFolderPath).SubFolders
For Each SF In SFs
SFName = SF.Name
TFN = Range("B2")
If InStr(SFName, TFN) <> 0 Then
FolderPathFrom = ParentFolderPath & "\" & SFName
Exit For
End If
Next
FileName1 = Dir(FolderPathFrom & "\*.txt")
FilePathFrom = FolderPathFrom & "\" & FileName1
Arr1 = Split(FileName1, "(")
Arr2 = Split(Arr1(1), ")")
FileName2 = Arr1(0) & "_" & Arr2(1)
FolderPathTo = Range("C2")
FilePathTo = FolderPathTo & "\" & FileName2
FileCopy FilePathFrom, FilePathTo
End Sub