I stumbled upon this code but I'm having a hard time getting it working. I'm trying to download a zip file containing a .csv from a website and putting the contents into my excel file. I'm currently stuck at this line:
'3 rename file
Name targetFileCSV As targetFileTXT
It says that it cannot find the file.
Any help is appreciated!
'Main Procedure
Sub LETSDOTHIS()
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://www20.statcan.gc.ca/tables-tableaux/cansim/csv/00260008-eng.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 target, 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
' Call UnZip(targetFolder, targetFileZip)
End Function
Private Sub UnZips(mainFolder As Variant, zipFolder As Variant)
Call UnZip(targetFolder, targetFileZip)
End Sub
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
