-2

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

Inside there is a csv file

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

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)

LucasSeveryn
  • 5,984
  • 8
  • 38
  • 65

2 Answers2

3

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
Miguel Febres
  • 2,153
  • 2
  • 21
  • 31
  • This is extremely useful. I am having a few issues though, main one I had when using my own method: whenever I extract the csv file from the zip file via VBA, the file seems to be still compressed (size does not change from 75kb to 1.1MB). If I use windows to extract, the file works okay. – LucasSeveryn Oct 21 '14 at 14:12
2

You can find it in simple codes there:

Download a File with VBA

Unzip Files

And use this Sub to import the file data to a new sheet.

Sub InsertCSVData()
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Ttemp\filename.csv", Destination:=Range("$B$7"))
        .Name = "filename"
        .FieldNames = True
        .RowNumbers = False
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        ' Don't forget to choose your delimiters and text type.
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Hope that helps.

RomeuForte
  • 53
  • 6