Брандмауэр Windows блокирует URLDownloadToFileA - PullRequest
Новая
       16

Брандмауэр Windows блокирует URLDownloadToFileA

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

У меня есть этот код для загрузки файла из интернета с EXCEL2013 VBA 64bit на Windows10 64bit.Он работает с выключенным брандмауэром, но не во время его работы.Я пытался сделать исключение брандмауэра для urlmon.dll, но это ничего не решило.Кто-нибудь с хорошими идеями? 

Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub DownloadFile(dateString As String)
    Dim DownloadFile As String, LocalFilename As String, URL As String, extraString As String
    Dim result As Long
    DownloadFile = dateString + ".xlsx"
    URL = Cells(1, 1).text
    If (InStr(URL, "/") <> 0) Then
        extraString = Mid$(URL, InStrRev(URL, "/") + 1)
        If (InStr(extraString, "_") <> 0) Then
            extraString = Mid$(extraString, 1, InStrRev(extraString, "_"))
            URL = Mid$(URL, 1, InStrRev(URL, "/"))
            URL = URL + extraString + DownloadFile
        End If
    End If
    LocalFilename = Application.ActiveWorkbook.path + Application.PathSeparator + dataFolderName + Application.PathSeparator + DownloadFile 'test.txt"
    Dim folderString As String
    folderString = Mid$(LocalFilename, 1, InStrRev(LocalFilename, Application.PathSeparator))
    If ((InStr(LocalFilename, Application.PathSeparator) <> 0) And (FileExists(folderString) = False)) Then  
        CreateFolder (folderString)
    End If
    result = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If (result <> 0) Then
        MsgBox "Error downloading webpage, check firewall/adress", vbOKOnly
    End If
End Sub
...