VBA：下載文件

我試圖從互聯網下載Excel文件，然後從中提取數據。問題是我沒有得到任何錯誤，但下載的文件只有1kb的大小。提取位工作，但文件是空的。實際文件大小爲350KB。VBA：下載文件

Sub ExtractDataTest() 

    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 = "http://enhanced1.sharepoint.hs.com/teams/" 

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

    If Dir("C:\xampp\htdocs\test", vbDirectory) = Empty Then MsgBox "No folder exist" 

    FileNum = FreeFile 
    Open "C:\xampp\htdocs\test\DE_TrackingSheet.xlsx" For Binary Access Write As #FileNum 
     Put #FileNum, 1, FileData 
    Close #FileNum 

    Dim FilePath$, Row&, Column&, Address$ 

'change constants & FilePath below to suit 
    '*************************************** 
    Const FileName$ = "DE_TrackingSheet.xlsx" 
    Const SheetName$ = "Open" 
    Const NumRows& = 50 
    Const NumColumns& = 20 
    FilePath = ("C:\xampp\htdocs\test\") 
    '*************************************** 

    DoEvents 
    Application.ScreenUpdating = False 
    If Dir(FilePath & FileName) = Empty Then 
     MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist" 
     Exit Sub 
     End If 
    For Row = 1 To NumRows 
     For Column = 1 To NumColumns 
      Address = Cells(Row, Column).Address 
      Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address) 
      Columns.AutoFit 
     Next Column 
    Next Row 
    ActiveWindow.DisplayZeros = False 
End Sub 


Private Function GetData(Path, File, Sheet, Address) 
    Dim Data$ 
    Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _ 
    Range(Address).Range("A1").Address(, , xlR1C1) 
    GetData = ExecuteExcel4Macro(Data) 
End Function

來源

2012-12-20 Homie

我用FTP運行過這個同樣的問題一次，我知道這似乎不重要，但要確保你的文件名是完全準確的。這是我的問題拋棄了我......這是一個簡單的多餘的空間或東西。 –

這是準確的。另外，如果出現拼寫錯誤，我會收到一條錯誤消息，並且在我的文件夾中肯定沒有1kb文件。 – Homie

您是否嘗試過使用'WorkBooks.Open（「http：// pathhere」）'。這應該工作。 –

它可能是事實數據是二進制的;

.... 
WHTTP.Open "GET", MyFile, False 
WHTTP.Send 

Set strm = CreateObject("ADODB.Stream") 
With strm 
    .Type = 1 
    .Open 
    .Write WHTTP.ResponseBody 
    .SaveToFile "C:\null\df.xlsx", 2 '//2==overwrite 
End With 
Set WHTTP = Nothing

來源

2012-12-20 16:21:29

VBA：下載文件

回答

相關問題