2016-05-23 128 views
0

我有一些代碼,我用來從本地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 
+0

IIRC,你的選擇是錯誤的 - 它應該是'objFolder.CopyHere ToPath,&H10&' – Rory

+0

@Rory Nevermind,這確實解決了這個問題。 Orgininal:精心設計?代碼的工作原理如上所示。 – ilarson007

回答

0

你可以禁止警告與

Application.DisplayAlerts = False 

一定要打開它(即Application.DisplayAlerts = True)你改寫你的文件之後。

+0

它仍然問我是否要覆蓋文件夾和文件。 – ilarson007

0

以上@rory的評論是正確的;從objFolder.CopyHere ToPath, &H0&更改爲objFolder.CopyHere ToPath, &1H0&修復了這個問題。