我有一些代碼,我用來從本地PC複製文件夾到網絡共享驅動器(備份)。我的代碼有兩個問題。首先,當代碼運行時,它就像Windows中的複製/粘貼一樣,如果文件已經存在,它會問我是否要覆蓋它們。我想覆蓋他們,因爲我每天都在運行代碼,所以我該如何壓制這一點?VBA複製文件; surpress「文件已經存在」並確定是否成功?
其次,我想能夠確定複製/粘貼是否成功發生。有沒有辦法做到這一點?
我正在使用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
IIRC,你的選擇是錯誤的 - 它應該是'objFolder.CopyHere ToPath,&H10&' – Rory
@Rory Nevermind,這確實解決了這個問題。 Orgininal:精心設計?代碼的工作原理如上所示。 – ilarson007