Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6641 / 76734

←次へ　｜　前へ→


	【75693】フォルダの検索、一致した場合のコピー方法

ペンネーム船長 - 14/6/15(日) 1:38 -


	引用なし

	パスワード

初めてお世話になります。

【やりたい事】
・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

3 hits

▼

【75693】フォルダの検索、一致した場合のコピー方法 ペンネーム船長 14/6/15(日) 1:38

≪