如何從網絡服務器的excel文件下載數據

Question

我想從位於互聯網web服務器上的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 

中，第二腳本，您的設置應該是這樣的（圖）。