我正在尝试使用 Excel 中的 VBA 在网络驱动器之间复制文件，

Question

我正在尝试使用 Excel 中的 VBA 在文件夹之间复制文件，使用 filesystemobject.CopyFolder 但仅在 C: 驱动器上，但无法跨网络驱动器执行此操作

我尝试过使用此程序

Sub aatest() 'Richards file copy procedure
    

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "\\swv082fs\Data\test"
    ToPath = "C:\Users\rilindley\Data"


    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath

End Sub

Answer 1

您的方法似乎总体上是合理的，我认为您只需要在代码中添加一些错误检查即可。您遇到的问题可能与网络权限或访问网络路径的方式有关：

• 确保您拥有

  FromPath

  和

  ToPath

  的读/写权限。
• 有时，使用

  WScript.Shell

  可以绕过网络路径的某些权限问题。

尝试使用

WScript.Shell

方法，或者更优雅地处理错误：

Sub CopyNetworkFolder()
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "\\swv082fs\Data\test\"
    ToPath = "C:\Users\rilindley\Data\"

    On Error GoTo ErrorHandler

    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Check if source folder exists
    If Not FSO.FolderExists(FromPath) Then
        MsgBox "Source folder doesn't exist: " & FromPath, vbExclamation
        Exit Sub
    End If

    ' Check if destination folder exists, create if it doesn't
    If Not FSO.FolderExists(ToPath) Then
        FSO.CreateFolder ToPath
    End If

    ' Copy the folder
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "Folder copied successfully!", vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description, vbCritical
End Sub