如何从Web服务器下载excel文件中的数据

Question

我想从位于互联网网络服务器上的excel文件中获取数据。 现在我的代码看起来像这样：

Sub test()
    Dim oExcel As Excel.Application

    ' open the webpage here
    Dim oWB As Workbook
    Set oExcel = New Excel.Application
    Set oWB = oExcel.Workbooks.Open("localhost/test/test.xlsx")

    Range("$A$1").Value = oWB
End Sub

但它不起作用。我该如何解决？

Answer 1

试试这样。

Sub DownloadFileWithVBA()

Dim myURL As String
'Right-click on the link named 'Sample Address File'
'Click 'Copy Link Location'
'Paste the link below
myURL = "http://databases.about.com/library/samples/address.xls"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile ("C:\Users\Excel\Desktop\address.xls")
    oStream.Close

End Sub

这对你也有帮助....

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

Private Sub pMain()
  Dim sURL As String
  Dim sDestination As String
  Dim bSuccess As Boolean
  Dim lRow As Long
  Dim ws As Excel.Worksheet
  Dim strSavePath As String
  Dim URL As String, ext As String
  Dim buf, ret As Long

  'Change to suit
  Set ws = ThisWorkbook.Worksheets("Sheet1")

  With ws
    For lRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
      sURL = .Cells(lRow, "A")
      sDestination = .Cells(lRow, "B")

      buf = Split(sURL, ".")
      ext = buf(UBound(buf))

        pos = InStrRev(sURL, "/", -1)
        file = Mid(sURL, pos + 1, 99)
        strSavePath = sDestination & file
        ret = URLDownloadToFile(0, sURL, strSavePath, 0, 0)
            If ret = 0 Then
                .Cells(lRow, "C") = "File download successfully!"
            Else
                .Cells(lRow, "C") = "Couldn't download the file!"
            End If

      DoEvents
    Next lRow
  End With
End Sub

在第二个脚本中，您的设置应该像这样（图像）。