如何将在线托管的csv导入Excel [英] How to import a zipped csv hosted online into Excel

问题描述

我有一个简单的链接www.example.com/file.zip

I have a simple link www.example.com/file.zip

里面有一个csv文件

下载文件没有登录表单，它是一个直接的链接。

There are no login forms required to download the file, it's a direct link.

有没有办法将文件下载到临时文件夹，解压缩，并作为新表格导入现有的表格？ （全部通过一个按钮VBA）

Is there any way to download the file to a temp folder, extract it, and import as a new sheet into the existing sheet? (All via one button VBA)

推荐答案

尝试以下代码。它使用Windows内置的zip功能，并正确加载CSV文件是将文件重命名为TXT所必需的。

Try the following code. It uses the zip functionality that is built in windows and to load correctly the CSV file is necessary to rename the file to TXT.

'Main Procedure
Sub DownloadAndLoad()

    Dim url As String
    Dim targetFolder As String, targetFileZip As String, targetFileCSV As String, targetFileTXT As String

    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String
    Dim newSheet As Worksheet

    url = "http://www.example.com/data.zip"
    targetFolder = Environ("TEMP") & "\" & RandomString(6) & "\"
    MkDir targetFolder
    targetFileZip = targetFolder & "data.zip"
    targetFileCSV = targetFolder & "data.csv"
    targetFileTXT = targetFolder & "data.txt"

    '1 download file
    DownloadFile url, targetFileZip

    '2 extract contents
    Call UnZip(targetFileZip, targetFolder)

    '3 rename file
    Name targetFileCSV As targetFileTXT

    '4 Load data
    Call LoadFile(targetFileTXT)

End Sub

Private Sub DownloadFile(myURL As String, target As String)

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

    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile targetFile, 2  ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If

End Sub


Private Function RandomString(cb As Integer) As String

    Randomize
    Dim rgch As String
    rgch = "abcdefghijklmnopqrstuvwxyz"
    rgch = rgch & UCase(rgch) & "0123456789"

    Dim i As Long
    For i = 1 To cb
        RandomString = RandomString & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
    Next

End Function

Private Function UnZip(PathToUnzipFileTo As Variant, FileNameToUnzip As Variant)
    ' Unzips a file
    ' Note that the default OverWriteExisting is true unless otherwise specified as False.
    Dim objOApp As Object
    Dim varFileNameFolder As Variant
    varFileNameFolder = PathToUnzipFileTo
    Set objOApp = CreateObject("Shell.Application")
    ' the "24" argument below will supress any dialogs if the file already exist. The file will
    ' be replaced. See http://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
    objOApp.Namespace(FileNameToUnzip).CopyHere objOApp.Namespace(varFileNameFolder).items, 24

End Function


Private Sub LoadFile(file As String)

     Set wkbTemp = Workbooks.Open(Filename:=file, Format:=xlCSV, Delimiter:=";", ReadOnly:=True)

     wkbTemp.Sheets(1).Cells.Copy
     'here you just want to create a new sheet and paste it to that sheet
     Set newSheet = ThisWorkbook.Sheets.Add
     With newSheet
         .Name = wkbTemp.Name
         .PasteSpecial
     End With
     Application.CutCopyMode = False
     wkbTemp.Close

End Sub

这篇关于如何将在线托管的csv导入Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！