| |
初めてお世話になります。
【やりたい事】
・Aフォルダーの中に複数のフォルダーがあります。
エクセルのA列にフォルダー名が列挙してあります。
このフォルダー一覧とＡフォルダーの中を照合し、合致したフォルダーがあれば そのフォルダーをＢフォルダーへコピーする。
マクロは、一覧表のあるエクセルに記述するものとします。
【コードを記述しましたが上手く動きません】
以下のコードを実行させたのですが、1フォルダーだけコピーが成功し、「CopyFrom = FSO.BuildPath(FolPath1, Folder.Name)」の行が黄色になって止まってしまいました。
間違っているところを指摘して下さると助かります。
Private Sub CommandButton1_Click()
Dim FSO As Object, Folder As Variant
Dim ws As Worksheet
Dim Rist As Variant
Dim i As Integer
Dim FolPath1 As String
Dim FolPath2 As String
Dim CopyFrom As String
Dim CopyTo As String
Set ws = Worksheets("一覧表")
Set FSO = CreateObject("Scripting.FileSystemObject")
FolPath1 = "C:\Users\○△□\Desktop\Aフォルダー"
FolPath2 = "C:\Users\○△□\Desktop\Bフォルダー"
For Each Folder In FSO.GetFolder(FolPath1).SubFolders
For i = 1 To 1000
Set Rist = ThisWorkbook.Worksheets("一覧表").Cells(i + 1, 1)
If Folder.Path = FolPath1 & "\" & Rist Then
'Aフォルダーの中のフォルダー名がリストと一致した場合、そのフォルダーをBフォルダーへコピーする
CopyFrom = FSO.BuildPath(FolPath1, Folder.Name)
CopyTo = FSO.BuildPath(FolPath2, Folder.Name)
FSO.CopyFolder CopyFrom, CopyTo
Set FSO = Nothing
End If
Next i
Next Folder
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
