VBA使用SHFileOperation將較新的文件從一個位置複製到另一個位置

Question

我有這段代碼可以將文件從一個位置複製到另一個位置，並且工作正常。我遇到的問題是將新文件複製到目的地。我做不是想覆蓋文件，只複製新文件。 這裏是我的代碼：

Public Declare Function SHFileOperation Lib "shell32.dll" _ 
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long 

Private Const FO_COPY = &H2 
Private Const FO_DELETE = &H3 
Private Const FO_MOVE = &H1 
Private Const FO_RENAME = &H4 
Private Const FOF_ALLOWUNDO = &H40 
Private Const FOF_CONFIRMMOUSE = &H2 
Private Const FOF_CREATEPROGRESSDLG = &H0 
Private Const FOF_FILESONLY = &H80 
Private Const FOF_MULTIDESTFILES = &H1 
Private Const FOF_NOCONFIRMATION = &H10 
Private Const FOF_NOCONFIRMMKDIR = &H200 
Private Const FOF_RENAMEONCOLLISION = &H8 
Private Const FOF_SILENT = &H4 
Private Const FOF_SIMPLEPROGRESS = &H100 
Private Const FOF_WANTMAPPINGHANDLE = &H20 

Public Type SHFILEOPSTRUCT 
    hWnd As Long 
    wFunc As Long 
    pFrom As String 
    pTo As String 
    fFlags As Integer 
    fAnyOperationsAborted As Long 
    hNameMappings As Long 
    lpszProgressTitle As Long 
End Type 

Public Sub VBCopyFolder(ByRef strSource As String, ByRef strTarget As String) 
Dim op As SHFILEOPSTRUCT 

With op 
    .wFunc = FO_COPY 
    .pTo = strTarget 
    .pFrom = strSource 
    .fFlags = FOF_SIMPLEPROGRESS 
End With 

'~~> Perform operation 
SHFileOperation op 
End Sub 

我調用子程序，像這樣

Call VBCopyFolder("O:\fieldticket\pdf\", "\\rwmain01\gis\FieldTicket\") 

Answer 1

這裏是一個選項，您可以試試。你將不得不迭代遍歷文件。所以，如果你有大量的文件建立起來，它可能會隨着時間的推移而變慢。

Public Sub CopyFiles() 
    Dim fso As Scripting.FileSystemObject 
    Dim fld As Scripting.Folder 
    Dim fils As Scripting.Files 
    Dim fil As Scripting.File 

    Dim strSourceFolder As String 
    Dim strDestFolder As String 
    Dim strFileName As String 

    On Error GoTo err_Proc 

    Set fso = CreateObject("Scripting.FileSystemObject") 

    strSourceFolder = "O:\fieldticket\pdf\" 
    strDestFolder = "\\rwmain01\gis\FieldTicket\" 

    If Not fso.FolderExists(strSourceFolder) Then GoTo exit_Proc 

    Set fld = fso.GetFolder(strSourceFolder) 

    For Each fil In fld.Files 
     ' Process the file with logic you consider new 
     If fil.DateCreated > Now - 1 Then 
      fso.CopyFile fil.Path, strDestFolder & fil.Name 
      DoEvents 
     End If 

     ' Or just try to copy it over with overwrite set to false 
     'fso.CopyFile fil.Path, strDestFolder & fil.Name, False 
    Next 

exit_Proc: 
    Set fil = Nothing 
    Set fils = Nothing 
    Set fld = Nothing 
    Set fso = Nothing 
    Exit Sub 
err_Proc: 
    Debug.Print Err.Description 
    GoTo exit_Proc 
End Sub