0

I am trying a VBA script for my job and at the end I would like it to back itself up by copying all the files to a network drive. This would take a very long time as its a lot of data and the VPN is slow.

Rather than writing my own progress bar script to let the user know it's still working can VBA just call the normal [Windows File Transfer Popup][1] to track this?

Here is the code I currently have however when I run it from a workbook it crashes the workbook without copying anything.

#If VBA7 Then    ' VBA7
Public Declare PtrSafe Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPtr

Public Const FO_COPY = &H2
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_NOCONFIRMATION As Long = &H10

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
#End If

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 Or FOF_NOCONFIRMATION
    End With

    '~~> Perform operation
    SHFileOperation op
End Sub
Sub copy_stuff()
Call VBCopyFolder("C:\Users\tihall\Daily Reports\V2 Testing\src", "C:\Users\tihall\Daily Reports\V2 Testing\dst")
End Sub
  • Guessing that would be some Win32 API call – Mathieu Guindon May 04 '20 at 22:53
  • 1
    Something like [this](https://stackoverflow.com/a/35823991/1188513) .net p/invoke code, but with VBA `Declare` statements and `Private Type` instead of `struct` – Mathieu Guindon May 04 '20 at 22:57
  • @MathieuGuindon I did find this thread on this site, but I didn't really understand it much. Is this at least on the right path? https://stackoverflow.com/questions/14227172/copy-files-with-progress-bar – Timothy Hall May 04 '20 at 23:01
  • Definitely, yes. – Mathieu Guindon May 04 '20 at 23:09
  • Thank you I'll just have to toy around with it until it works. Would you know off top of your head why ```Public Declare Function SHFileOperation Lib "shell32.dll" _ Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long``` would be red and refuse to compile? – Timothy Hall May 04 '20 at 23:13
  • That would be because you're in 64-bit VBA7 and the code would have been for 32-bit. Try `Public Declare PtrSafe Function SHFileOperation Lib "shell32.dll" _ Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long`; you'll need `#If Win64` conditional compilation if your code needs to work in both 32 and 64 bits – Mathieu Guindon May 04 '20 at 23:16
  • Thank you very much. I have it "Working". Meaning it's running, but for some reason crashing the workbook i run it out of. I'm sure I can I figure it out tomorrow as it's end of day for me. Again Thanks for the help! – Timothy Hall May 04 '20 at 23:18
  • Procedure scopes responsible for file I/O operations should **always** handle runtime errors - same for procedure scopes responsible for Win32 API calls. Needless to say if error handling is needed for Win32 API calls that perform file I/O operations ;-) – Mathieu Guindon May 04 '20 at 23:22
  • ...that said I just tried wrapping Sid's code into a class, and fed it inexisting file names, was expecting an error, got nothing. Wish I could help more. – Mathieu Guindon May 04 '20 at 23:31
  • I'm sorry I don't understand your previous comment about procedure scopes and runtime error handling. I really don't know enough about api calls to make this work on my own. Little more help please? I'v updated the original question with my code – Timothy Hall May 06 '20 at 23:01

1 Answers1

0

I could not figure out the Windows API, so I scrapped the entire code and found something else on this site. This StackOverFlow Thread Had a much simpler solution to my problem.

I was able to get it working perfectly with this code below. I used the solution given by tmoore82. The Call VARS is to get the PATHS I need as Variables.

Public Function Copystuff(ByVal vSource, ByVal vDest) As Long
    Dim objShell, objFileSource, objFileDest As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFileSource = objShell.Namespace((vSource)) 
    Set objFileDest = objShell.Namespace((vDest)) 
    Call objFileDest.CopyHere(objFileSource.Items)
End Function

Sub copystuff2()
Dim src, dest
Call VARS
vSource = DL_PATH
vDest = PATH_TO_NETWORK_DRIVE

Call Copystuff(vSource, vDest)
End Sub