有没有办法将位于我的网站目录中的文件复制到我的本地驱动器访问vba

Posted 2023-01-12

我有一个遗留的vba程序正试图实现软件更新功能。这将要求我从我们网站上的某个位置复制更新，并在用户系统上保存临时更新。

我已经在桌面上实现了更新程序，但是从我们的站点复制补丁有问题。我已经尝试过使用\ oursite.com \ folder \ file.txt的一些建议，但是这对我来说没有用，因为它说找不到文件。

 downloadPaths(0) = "\\oursite.com\foldername\update\test.txt"

'once we have our folder in place, we will download the current update
' and save in the current local folder
If (IsArray(downloadPaths)) Then
    ' we will loop over each download patches to get from source
    For Each updatepath In downloadPaths
        If (updatepath <> "") Then
            If (fs.FileExists(updatepath)) Then
            ' do whatever here 
            end if 
         end if 
     next
end if

答案

好吧，没有人试图回答这个问题，我决定发布我提出的解决方案。它很脏，但它确实完成了工作，并且软件更新功能已完成。请注意，在验证成功下载时，您的服务器将确定要检查的响应。我使用Apache，mysql和php 5>。

Public Function downloadFileFromUrl(sourceUrl As Variant, destinationPath As Variant) As Boolean

On Error GoTo downloadFileFromUrlError

Dim validFile As Boolean

  'It takes a url (sourceUrl) and downloads the URL to destinationPath.

      With New WinHttpRequest
          'Open a request to our source
          .Open "GET", sourceUrl

          'Set this to get it to go through the firewall
          .SetAutoLogonPolicy AutoLogonPolicy_Always
          .SetProxy 2, "http://127.0.0.1:8888", "*.never"
          .SetRequestHeader "Accept", "*/*"

          'Set any options you may need http://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx
          'Set a custom useragent, not needed, but could be useful if there are problems on the server
          .Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; VBA Wget)"

          'Automatically follow any redirects
          .Option(WinHttpRequestOption_EnableRedirects) = "True"

          .Send

          ' check if the download is a valid file before we write to file
            If (isValidFileDownload(.responseText)) Then
                'Write the responseBody to a file
                Dim ado As New ADODB.Stream
                ado.Type = adTypeBinary
                ado.Open
                ado.Write .ResponseBody
                ado.SaveToFile destinationPath, adSaveCreateOverWrite
                ado.Close
                downloadFileFromUrl = True    'download was successful
            Else
                downloadFileFromUrl = False    'download was not successful
            End If

      End With

      downloadFileFromUrlExit:
      On Error Resume Next
      Set ado = Nothing
      Exit Function

      downloadFileFromUrlError:

      downloadFileFromUrl = False    'An error occurred
      Select Case Err
      Case Else
          Debug.Print "Unhandled Error", Err.Number, Err.description, Err.Source, Erl()
      End Select
      Resume downloadFileFromUrlExit
   Resume

结束功能

Private Function isValidFileDownload(responseText As Variant) As Boolean

On Error Resume Next
If (InStr(1, left(responseText, 1000), "<h1>Object not found!</h1>")) Then
    Exit Function
Else
    isValidFileDownload = True
End If

结束功能