VBAをダウンロード、エクストラクトしてExcel 2007にインポートする

Question

誰かがこのスクリプトを私のために調整できますか？私は元の質問（26486871）の助けを求めましたが、私の要求は削除されました。

このスクリプトでは、公開Webサイトからzipファイルをダウンロードし、ファイルを抽出し、データをワークシートにインポートする必要があります。ジップにはcsvファイルがありません

1. ：

   はしかし、私は2つの例外があります。テキストファイル（20MB）のみが含まれています。

2. 私は新しいワークシートを望んでいません。ワークシート内の既存のデータを以前のインポートから上書きしたい。

私は2日間、このスクリプトを使って手を加えてきましたが、それは次のように立ち往生：

「実行時エラー 『3001』：引数が間違った型、許容範囲外です、または互いに葛藤している」と述べた。これは違いを作る場合は、そのエラーの

、Stream.SaveToFileこのtargetFileにスクリプトエディタポイント、1 '1 =なし、上書きが、2 =

を上書きし、zip形式のテキストファイルが整列するデータを分離タブスペースを持っていますテキストから列へ

このスクリプトの開発については、Miguel Febresに感謝します。

私は助けていただきありがとうございます。

---

'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) & "" 

    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 

Answer 1

こんにちはブルース以下を見てください。それはあなたのダウンロードの問題を解決するはずです。

'' 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