如何使用 vba 从 Google Drive 下载 excel 文件？

Question

我正在尝试使用 vba 代码从 Google 驱动器下载 excel 文件。 该文件在此路径 C:/MyDownloads/serial.xlsx 中下载。 但是在第一个工作表中下载的 excel 文件的顶部添加了一些奇怪的文本。 而且我还收到一条弹出消息，其中显示您尝试打开的文件与指定的格式不同。 所以我点击是来浏览这个弹出窗口，然后我得到一个 css 文件丢失错误弹出窗口。 为什么会发生这种情况以及为什么这些错误会出现在我下载的 excel 文件中。 我的数据也显示在 excel 添加的奇怪文本的底部。

Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object

On Error Resume Next
    Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
    If Err.Number <> 0 Then
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
    End If
On Error GoTo 0

MyFile = "https://docs.google.com/spreadsheets/d/1e6DNpw3y5NrMR9cNLmIZdPYO79WLui7mua5I-5pEyKo/edit?usp=sharing"

WHTTP.Open "GET", MyFile, False
WHTTP.send
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

If Dir("C:\Downloads", vbDirectory) = Empty Then MkDir "C:\Downloads"

FileNum = FreeFile
Open "C:\Downloads\serial.xls" For Binary As #FileNum
    Put #FileNum, 1, FileData
Close #FileNum

MsgBox "Open the folder [ C:\Downloads ] for the "

Answer 1

使用“GetSpecialFolder”UDF，您可以从任何云驱动器下载文件，就像：

FileCopy GetSpecialFolder(vbDirGoogleDrive) & "serial.xlsx", "C:/MyDownloads/serial.xlsx"

http://www.EXCELGAARD.dk/Lib/GetSpecialFolder/

您还可以使用：

FileCopy GetSpecialFolder(vbDirGoogleDrive) & "serial.xlsx", GetSpecialFolder(vbDirDownloads) & "serall.xlsx"*

您甚至可以在 Google Drive 和 Dropbox 之间移动文件：

FileCopy GetSpecialFolder(vbDirGoogleDrive) & "serial.xlsx", GetSpecialFolder(vbDirDropbox) & "serall.xlsx"*

Answer 2

寻找作者

Option Compare Database
Public stTXT As String
'This line is to enable the 'Sleep' function which I use later.
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

'To enable Excel.Application, Excel.Workbook and Excel.Worksheet - you need to enable
'the Excel objects in your Access file: in the VBA application go to 'Tools' menu > 
References.
'Find the Microsoft Excel 12.0 Object Library, and activate the checkbox.
'Now you have the full Excel library at your service.
'Here I used 'Object' - which is enough to make it work without the excel library.
    Dim appXL As Object 'Excel.Application
    Dim wbk As Object 'Excel.Workbook
    Dim wst As Object 'Excel.Worksheet
    Dim Timer As Integer

    Set appXL = CreateObject("Excel.Application")
'    appXL.Visible = True 'If you want to see the excel sheet - enable this row (good 
for debugging)
    Set wbk = appXL.Workbooks.Add
    Set wst = wbk.Worksheets(1)

    With wst
'In the following row, after the word 'key=' until the '&gid' - put the code-number 
of the google-doc spreadsheet, which you extract from the link you get for the 
spreadsheet google-doc (looks like: 'KeXnteS6n6...')

        .QueryTables.Add Connection:= _
            "URL;https://spreadsheets.google.com/tq?tqx=out:html&tq=&key=???&gid=1" _
            , Destination:=.Range("$A$1")
        .Name = "Worksheet1"
'The following fields are available if enabling Excel library (See above)
'        .FieldNames = True
'        .RowNumbers = False
'        .FillAdjacentFormulas = False
'        .PreserveFormatting = True
'        .RefreshOnFileOpen = False
'        .BackgroundQuery = True
'        .RefreshStyle = xlInsertDeleteCells
'        .SavePassword = False
'        .SaveData = True
'        .AdjustColumnWidth = True
'        .RefreshPeriod = 0
'        .WebSelectionType = xlEntirePage
'        .WebFormatting = xlWebFormattingNone
'        .WebPreFormattedTextToColumns = True
'        .WebConsecutiveDelimitersAsOne = True
'        .WebSingleBlockTextImport = False
'        .WebDisableDateRecognition = False
'        .WebDisableRedirections = False
'        .Refresh BackgroundQuery:=False

        .QueryTables(1).Refresh
    End With

    'Wait for google-doc data to be downloaded.
    Timer = 0
    Do While Left(wst.Cells(1, 1), 12) = "ExternalData" And Timer < 40
        Sleep 250   ' Wait 0.25 sec before re-checking data
        Timer = Timer + 1
    Loop

    MsgBox "The value of cell AG2 is: " & wst.Cells(2, 34)

'Here you can work with the data...

'    wbk.Close SaveChanges:=False 'Don't save excel sheet
    wbk.Close SaveChanges:=True, FileName:="C:\Users\(User Name)\Desktop\GDocs" 'Save 
excel sheet in 'Documents' folder
    appXL.Quit

 'On Error GoTo ErrorHandler

  Exit Sub

Answer 3

试试下面的代码，

Sub Basic_Web_Query() Dim chromePath As String Sheets("Sheet2").Select Range("A2").Select Selection.Copy Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe") SendKeys "^v" SendKeys "~" Application.Wait (Now + TimeValue("00:00:10")) SendKeys "^a" SendKeys "^c" Application.Wait (Now + TimeValue("00:00:10")) Sheets("Sheet1").Select Range("A1").Select ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _ False End Sub

---