Разница между загрузкой сайта в VBA и вручную - PullRequest
0 голосов
/ 17 сентября 2018

После написания сценария для загрузки следующего HTML-источника: view-source: https://calendar.google.com/calendar/r?pli=1, Я заметил, что это другая страница по сравнению с тем, когда я загружаю ее вручную.

Я думаю, это потому, что Excel использует другой (экземпляр) браузер для его загрузки, и в этом браузере я не вошел в систему. У меня не установлено никаких других браузеров, кроме Chrome.Моя цель - загрузить исходный код view-source: https://calendar.google.com/calendar/r?pli=1 через браузер Chrome после того, как я уже вошел в браузер Chrome (следовательно, без ввода учетных данных в Excel).

Может кто-нибудьобъясните, почему существует разница между страницей, загруженной в Excel, и страницей, загруженной вручную *?

* Это код, который я использовал для загрузки веб-сайта:

Sub GetHTTP()
' Before the first run: click tools> references> enable: Microsoft WinHTTP Services, version 5.1
Dim objHttp As Object
Dim CachedFilePath As String
    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    Call objHttp.Open("GET", "https://calendar.google.com/calendar/r?pli=1", False)
    Call objHttp.send("")
    'CachedFilePath = Environ("temp") & "\" & "ReplaceThisWithFilename" & ".html"
    CachedFilePath = ThisWorkbook.Path & "\Websitesource" & "\" & "ReplaceThisWithFilename" & ".html"
    Call CreateFile(CachedFilePath, objHttp.responseText)
    DeleteFile (ThisWorkbook.Path & "\Websitesource" & "\" & "ReplaceThisWithFilename" & ".txt")
    Name CachedFilePath As ThisWorkbook.Path & "\location" & "\" & "ReplaceThisWithFilename" & ".txt"

End Sub

Function CreateFile(FileName As String, Contents As String) As String
' creates file from string contents
Dim tempFile As String
Dim nextFileNum As Long
  nextFileNum = FreeFile
  tempFile = FileName
  Open tempFile For Output As #nextFileNum
  Print #nextFileNum, Contents
  Close #nextFileNum
  CreateFile = tempFile
End Function
Public Function DeleteFile(ByVal FileToDelete As String)
   ' Source: /52840/udalenie-faila-v-vba#52845
   If FileExists(FileToDelete) Then 'See above
      ' First remove readonly attribute, if set
      SetAttr FileToDelete, vbNormal
      ' Then delete the file
      Kill FileToDelete
   End If
End Function
Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function

Я также попробовал реализацию, предложенную здесь , но она выдает ошибку «отказано в доступе», даже после попытки замены учетных данных в указанном формате.

Sub DownloadFile()
Dim oStream As Object
Dim myURL As String
'myURL = "view-source:https://calendar.google.com/calendar/r?pli=1"
myURL = "https://calendar.google.com/calendar/r?pli=1"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
'WinHttpReq.Open "GET", myURL, False, "username", "password"
'WinHttpReq.Open "GET", myURL, False, "<username@gmail.com>", "<password>"
'WinHttpReq.Open "GET", myURL, False, "<username>", "<password>"
WinHttpReq.Open "GET", myURL, False
WinHttpReq.send

myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "C:\location", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...