如何用VBA复制整个文件夹包括子目录？

Sub copyFiles(Path As String, afterPath)

'Path：原文件夹路径；afterPath：目标文件夹路径

Dim Spath As String

Set fs = CreateObject("Scripting.FileSystemObject")

Spath = Dir(Path, vbDirectory)

Do While Len(Spath)

If Spath <>"." And Spath <>".." Then

fs.CopyFolder Path, afterPath

Spath = Dir()

End If

Loop

End Sub

————————————————

版权声明：本文为CSDN博主「前端小菜鸟007」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。

原文链接：https://blog.csdn.net/weixin_41844140/article/details/103188537

假设我们需要将文件夹“C:\FolderA”中的符合下面条件的文件，拷贝到“C:\FolderB”中。

拷贝条件：扩展名是xls或xlsx，并且文件名中不包含“OK”字样。

在Excel中插入一个ActiveX按钮，在按钮的事件中加入如下代码：

Private Sub CommandButton1_Click()

Dim Fso As Object

Set Fso = CreateObject("Scripting.FileSystemObject")

Dim fs, f, f1, fc

On Error Resume Next

Set fs = CreateObject("scripting.filesystemobject")

Set f = fs.GetFolder("C:\FolderA")

Set fc = f.Files

If Err.Number <>0 Then

MsgBox "From Folder Open Error!" &vbCrLf &Err.Description &vbCrLf

GoTo Err

End If

On Error GoTo 0

For Each f1 In fc

If (Right(f1, 3) = "xls" Or Right(f1, 4) = "xlsx") And InStr(1, f1, "OK") <= 0 Then

On Error Resume Next

Fso.CopyFile f1, SetFolderPath("C:\FolderB")) &GetFileName(f1)

If Err.Number <>0 Then

MsgBox "File Copy Error!" &vbCrLf &Err.Description

GoTo Err

End If

On Error GoTo 0

End If

Next

MsgBox "File Copy is over."

Err:

Set fs = Nothing

Set f = Nothing

Set f1 = Nothing

Set fc = Nothing

Set Fso = Nothing

End Sub

Sub 拷贝文件夹()

On Error Resume Next

Set fs = CreateObject("Scripting.FileSystemObject")

For i = 2 To 100

  If Cells(i, 1) = "" Then Exit For

  OldString = "路径\说明书"

  NewString = "路径" &Cells(i, 1) &"\说明书"

  fs.Copyfolder OldString, NewString

  Set fs = Nothing

Next

End Sub

---