Question

我有一些代码用于将文件夹从本地PC复制到网络共享驱动器（备份）。我的代码有两个问题。首先，当代码运行时，它就像在Windows中复制/粘贴一样，如果文件已经存在，它会询问我是否要覆盖它们。我确实想覆盖它们，因为我每天都在运行代码，所以如何抑制它呢？

其次，我希望能够确定复制/粘贴是否成功。有没有办法做到这一点？

我正在使用VBA复制功能，但它没有显示任何进度条，所以我担心我会在某些时候打开Outlook并弄乱文件副本。无论如何，这是我的代码。

Private Sub Main()

    'unrelated code

    If Len(Dir("\\aubinsFS01\E9786046$\")) <> 0 Then
        If Len(Dir("C:\Users\E9786046\Documents\Outlook Files\")) <> 0 Then

                'Taken from multiple examples
                'http://www.mrexcel.com/forum/excel-questions/238407-progress-bar-copying-file.html

                Dim FromPath As Variant
                Dim ToPath As Variant

                FromPath = "C:\Users\E9786046\Documents\Outlook Files\"  '<< Change
                ToPath = "\\aubinsFS01\E9786046$\Personal Folder Backup"    '<< Change

                Application.Wait (Now + TimeValue("0:00:05"))       'Delay to allow Outlook to close

                Set objShell = CreateObject("Shell.Application")
                '//The source Folder to CopyFrom:
                Set objFolder = objShell.Namespace(FromPath)

                '//The source Folder to CopyTo:
                objFolder.CopyHere ToPath, &H0&

                Set objShell = Nothing
                Set objFolder = Nothing

                MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
        Else
            MsgBox "Personal folder location not found.  Please check your personal folder."
        End If
    Else
        MsgBox "Network location not available.  Check your shared drives for connection."
    End If

    ThisWorkbook.Close
    End

End Sub

Answer 1

您可以使用

来抑制警告

Application.DisplayAlerts = False

确保在覆盖文件后重新打开（例如Application.DisplayAlerts = True）。

Answer 2

以上@rory的评论是正确的;从objFolder.CopyHere ToPath, &H0&更改为objFolder.CopyHere ToPath, &1H0&解决了问题。

VBA复制文件; surpress＆＃34;文件已经存在＆＃34;并确定是否成功？

2 个答案: