Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA Функция для скачивания данных из сети
 
Добрый день, всем.
Суть проблемы в следующемю Есть функция

Код
Public Function Downloading(ByVal URL As String, ByVal LocalPath As String) As Boolean
Dim ADOStream_responseBody As Variant
'Dim XMLHTTP_statusText As Variant
On Error Resume Next
  If AppState.FSO.FileExists(LocalPath) Then AppState.FSO.DeleteFile LocalPath, True
  If AppState.FSO.FileExists(LocalPath) Then Downloading = True: Exit Function
  With CreateObject("Microsoft.XMLHTTP")
    .Open "GET", Replace(URL, "\", "/"), False
    .Send
    If .Status = 200 Then ADOStream_responseBody = .responseBody
'    XMLHTTP_statusText = .statusText
    Downloading = (.Status = 200)
  End With
  If Downloading Then
    With CreateObject("ADODB.Stream")
      .Type = 1
      .Open
      .Write ADOStream_responseBody
      .SaveToFile LocalPath, 2
      .Close
    End With
  Else
'    MsgBox "Can not download file" & Chr(13) & URL & Chr(13) & XMLHTTP_statusText & "!", vbApplicationModal + vbExclamation + vbOKOnly, "Cargill"
    Downloading = False
  End If
'  Downloading = IIf(CBool(Downloading), LocalPath, vbNullString)
End Function

с помощью которой скачиваются файлы из Интренет, например так

Код
Public Sub test()
  Downloading "https://www.gov.uk/government/uploads/system/uploads/attachment_data/file/678222/eggs-packers-01feb1...;, "C:\Tmp\0\eggs-packers-01feb18.ods"
End Sub

в самой функции скачивания возникает ошибка ("Access is denied."), которую у меня побороть не получается. Ошибка возникает на  строке
Код
.Send

Так же есть следующий код
Код
#If VBA7 Then
  Private 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
#Else
  Private Declare 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
#End If
...
  URLDownloadToFile 0, "https://www.gov.uk/government/uploads/system/uploads/attachment_data/file/678222/eggs-packers-01feb18.ods&am...;, "C:\Tmp\0\eggs-packers-01feb18.ods", 0, 0
...
который, как-то выборочно работает (на моей Win7 - ok, на чужой WIN 10 - нет)

Кто-нибудь сталкивался с подобным, можете помочь?
Заранее спасибо!
Страницы: 1
Читают тему (гостей: 1)