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：下载文件

回答

相关问题