Есть ли способ скопировать файл, расположенный в каталоге моего сайта на мой локальный диск с доступом VBA - PullRequest
Новая
       17

Есть ли способ скопировать файл, расположенный в каталоге моего сайта на мой локальный диск с доступом VBA

0 голосов
/ 02 апреля 2019

У меня есть устаревшая программа 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

1 Ответ

0 голосов
/ 29 апреля 2019

Ну, так как никто не пытается ответить на этот вопрос, я решил опубликовать решение, которое придумал. Это грязно, но это делает работу, и функциональность обновления программного обеспечения завершена. Обратите внимание, что при проверке успешной загрузки ответ на проверку будет определять ваш сервер. Я использую 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

Функция завершения

...