VBA 使用 SHFileOperation 将较新的文件从一个位置复制到另一个位置

Question

我有这段代码可以在 Access 2010 中将文件从一个位置复制到另一个位置，并且工作正常。我遇到的问题是仅将 新文件 复制到目的地。我不想覆盖文件，只复制新文件。这是我的代码：

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

VBA 使用 SHFileOperation 将较新的文件从一个位置复制到另一个位置

VBA Copying Newer Files from one location to another using SHFileOperation

ms-access

vba

ms-access-2010