So laden Sie Daten von einer Excel-Datei von Webserver

Question

Ich möchte Daten von Excel-Datei erhalten, die auf Internet-Webserver befindet. Nun ist mein Code sieht wie folgt aus:

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 

Aber es funktioniert nicht. Wie kann ich es lösen?

Answer 1

Versuchen Sie es so.

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 

Dies Sie auch ....

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 

Im zweiten Skript sollte helfen, Ihr Setup wie dieses (Bild) sein sollte.