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