Search code examples
htmlexcelvbaweb-scraping

VBA download a document from a public Google Drive address - .click event(?)

Update: it appears to needing a .click event, but unable to determine the correct syntax to use with the existing code.

Original Post: I tried to adapt an existing stackoverflow answer code to my problem (as well as some other excel forum answers), but it has not resulted in the same solution. Any assistance would be appreciated.

I am trying to download a public file on a public google drive address. I am the owner of neither the doc or drive.

I have attempted using multiple file extensions, but when I used the html I noticed it was only taking the header, not the "container".

I am trying to grab the file in any format (docx, pdf, txt, csv)

Public File:

https://docs.google.com/document/d/1RaIps4g70ZWalb2UkLticEHM0OGcZF6h/edit?usp=sharing&ouid=111533769991350336043&rtpof=true&sd=true

or

https://docs.google.com/document/d/1RaIps4g70ZWalb2UkLticEHM0OGcZF6h/edit

   Sub downloadFile()

      Const FOLDER = "C:\temp\"
    
      Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
      Dim wb As Workbook: Set wb = ThisWorkbook
      Dim ws As Worksheet: Set ws = wb.Sheets(1)
    
      If Not (fso.FolderExists(FOLDER)) Then MkDir FOLDER
    
      Dim oWinHttp As Object: Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
      Dim oStream As Object: Set oStream = CreateObject("ADODB.Stream")
    
      Dim URL As String: URL = ws.Cells(2, 1).Value
      Dim ext As String: ext = ".docx"
    
      ' check folder exists
      If Not fso.FolderExists(FOLDER) Then
         MkDir FOLDER
      End If

        oWinHttp.Open "GET", URL, False
        oWinHttp.Send
        If oWinHttp.Status = 200 Then

            With oStream
                .Open
                .Type = 1
                .Write oWinHttp.ResponseBody
                .SaveToFile FOLDER & "File " & ext, 2 ' 1 = no overwrite, 2 = overwrite
                .Close
            End With

            Else
                MsgBox URL, vbExclamation, "Status " & oWinHttp.Status
        End If
    
      MsgBox "File created", vbInformation

   End Sub
Solution

  • For a simpler alternative VBS can use sendkeys, it is second-best to a robotic browser approach like puppeteer, but often simple is fast enough to adjust.

    Requirements are that Edge (or chrome etc) is auto downloading to a fixed folder (here "downloads") because in this case there is unwanted confusion selecting "Save AS"

    Launch browser from CMD line or via VBA shell command & trigger VBscript.

    enter image description here

    "%programfiles%\Microsoft\Edge\Application\msedge.exe" --app=https://docs.google.com/document/d/1RaIps4g70ZWalb2UkLticEHM0OGcZF6h/edit
echo running script
timeout 8 && cscript savefiles.vbs

    savefiles.vbs

    ' Edge is already open waiting for commands
 ' It is important that saving is to a fixed directory
 ' not open the "Where to save" dialog

Set WshShell = WScript.CreateObject("WScript.Shell")
WScript.Sleep(100)

' we need to use the app name  which is the TitleBar name
WshShell.AppActivate("01-1-2024 MONTHLY PRICE INDICES FOR ASPHALT CEMENT FOR ASPHALT CEMENT.docx")

' Type in ALT F to trigger File Menu actions set time gaps as required 1000=1second
WshShell.SendKeys "%F"
WScript.Sleep(100)
WshShell.SendKeys "%D"
WScript.Sleep(100)
WshShell.SendKeys "x"
WScript.Sleep(8000)
WshShell.SendKeys "{ENTER}"
WScript.Sleep(100)
WshShell.SendKeys "{ESC}"
' Add more user specific key ins e.g Opendocs
WshShell.SendKeys "%F"
WScript.Sleep(100)
WshShell.SendKeys "%D"
WScript.Sleep(100)
WshShell.SendKeys "o"
WScript.Sleep(8000)
WshShell.SendKeys "{ENTER}"
WScript.Sleep(100)
WshShell.SendKeys "{ESC}"