Может ли VBA вызвать всплывающее окно передачи файлов windows? - PullRequest
0 голосов
/ 05 мая 2020

Я пробую сценарий VBA для своей работы и в конце я хотел бы, чтобы он сделал резервную копию, скопировав все файлы на сетевой диск. Это займет очень много времени, так как данных много, а VPN работает медленно.

Вместо того, чтобы писать собственный сценарий индикатора выполнения, чтобы пользователь знал, что он все еще работает, может ли VBA просто вызвать обычное [Windows всплывающее окно передачи файлов] [1], чтобы отслеживать это?

Здесь это код, который у меня сейчас есть, однако, когда я запускаю его из книги, он приводит к сбою книги без копирования.

#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

1 Ответ

0 голосов
/ 07 мая 2020

Мне не удалось понять Windows API, поэтому я выбросил весь код и нашел что-то еще на этом сайте. Этот поток StackOverFlow У меня было гораздо более простое решение моей проблемы.

Я смог заставить его отлично работать с помощью этого кода ниже. Я использовал решение, данное tmoore82. Call VARS предназначен для получения необходимых мне ПУТЬ в виде переменных.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...