VBA下载、提取并导入Excel 2007

有人能为我量身定做这个剧本吗？我在原始问题（26486871）中请求帮助，但我的请求被删除

这个脚本完成了我需要的工作：从公共网站下载一个zip文件，提取该文件…并将数据导入工作表

但是，我有两个例外：

zip中没有csv文件。它只包含一个文本文件（20MB）

我不想要新的工作表。我想覆盖上一次导入工作表中的现有数据

我已经修改这个脚本两天了，但它在以下方面卡住了：

运行时错误“3001”：参数类型错误、超出可接受范围或相互冲突

在该错误中，脚本编辑器指向Stream.SaveToFile targetFile，1'1=不覆盖，2=覆盖

如果这有区别，压缩的文本文件会有分隔数据的选项卡空间，以将文本与列对齐

我要感谢Miguel Febres开发了这个脚本

我将感谢任何帮助

---

---

嗨，布鲁斯，看下面的。它应该可以解决你的下载问题

'' This function downloads a file from a given webpage named 'url' and copies it to 'copylocation' named as 'filename'.
'' It is vital to check which format does the content has. For example: xlsx, csv, txt etc. This must be determined in 'downloadformat'.
'' If an already existing file should be overwriten, then overwritefile = TRUE must be set.
''
'' Example of use: GetWebpageContent("http://www.snb.ch/n/mmr/tcoreference/Current%20Rates/Interest_Rates/source/interest_rates.xlsx",
''              "F:\public\CurrentMarketRates",
''              "SARM", "xlsx", TRUE)
''
Function GetWebpageContent(url As String, copylocation As String, filename As String, downloadformat As String, overwritefile As Boolean) As Boolean
    Dim WinHttpReq As Object, fname As String, res As Boolean
    Dim owritef As Integer
        owritef = 1
    ''do not overwrite, unless overwritefile = TRUE
    If overwritefile Then
        owritef = 2
    End If
    ''create filename and location
    res = True
    fname = "\" & filename & "_" & Year(Now) & "." & downloadformat

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", url, False
    WinHttpReq.Send

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

    GetWebpageContent = res
End Function

---

“它只包含一个文本文件（20MB）。”没有告诉我们。。您可以从文件中放入几行示例行，或者指定它是以制表符分隔的、固定宽度等。文本文件是以制表符分隔的。然后您可以尝试类似于

Set wkbTemp=Workbooks.Open的操作（Filename:=file，Format:=xlTextWindows，Delimiter:=vbTab，ReadOnly:=True）

或者调整它以匹配非常好的格式。但是，在导入之前，脚本会出错。它会出错，因为它假定zip中存在csv文件。我应该像最初的海报那样问一个问题。我需要一个vba脚本从公共网站下载zip…提取制表符分隔的文本文件…并将数据导入当前工作表。导入将覆盖以前的任何导入。感谢您的脚本。我已经解决了下载问题。现在我正在解决解压问题。@Bruce你有没有试过？会对我有用的。我确实让它运行起来了；但是，我必须使用两个不同的函数。我无法使导入与下载和解压宏一起工作。运行Download&Unzip后，我运行Data选项卡下的Refresh All命令来导入数据。

'' This function downloads a file from a given webpage named 'url' and copies it to 'copylocation' named as 'filename'.
'' It is vital to check which format does the content has. For example: xlsx, csv, txt etc. This must be determined in 'downloadformat'.
'' If an already existing file should be overwriten, then overwritefile = TRUE must be set.
''
'' Example of use: GetWebpageContent("http://www.snb.ch/n/mmr/tcoreference/Current%20Rates/Interest_Rates/source/interest_rates.xlsx",
''              "F:\public\CurrentMarketRates",
''              "SARM", "xlsx", TRUE)
''
Function GetWebpageContent(url As String, copylocation As String, filename As String, downloadformat As String, overwritefile As Boolean) As Boolean
    Dim WinHttpReq As Object, fname As String, res As Boolean
    Dim owritef As Integer
        owritef = 1
    ''do not overwrite, unless overwritefile = TRUE
    If overwritefile Then
        owritef = 2
    End If
    ''create filename and location
    res = True
    fname = "\" & filename & "_" & Year(Now) & "." & downloadformat

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", url, False
    WinHttpReq.Send

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

    GetWebpageContent = res
End Function