Importing zipped csv file to Excel using VBA

[MMcCarthy]

Hi guys,

I'm looking for some advice. I have to import a csv file which is on a website page in zip format. I have a piece of code thats supposed to work with winzip but I don't think the client has winzip available. Before I insist that they must get it I was wondering if anyone has any other method that would work with windows compressed files option.

This process has to be automated.

Any advice welcome.

Mary

[Rabbit]

Is it legacy compression? Windows has it's own zip with command line functionality.

Copyright (C) 1990-1999 Info-ZIP
Type 'zip "-L"' for software license.
Zip 2.3 (November 29th 1999). Usage:
zip [-options] [-b path] [-t mmddyyyy] [-n suffixes] [zipfile list] [-xi list]
  The default action is to add or replace zipfile entries from list, which
  can include the special name - to compress standard input.
  If zipfile and list are omitted, zip compresses stdin to stdout.
  -f   freshen: only changed files  -u   update: only changed or new files
  -d   delete entries in zipfile    -m   move into zipfile (delete files)
  -r   recurse into directories     -j   junk (don't record) directory names
  -0   store only                   -l   convert LF to CR LF (-ll CR LF to LF)
  -1   compress faster              -9   compress better
  -q   quiet operation              -v   verbose operation/print version info
  -c   add one-line comments        -z   add zipfile comment
  -@   read names from stdin        -o   make zipfile as old as latest entry
  -x   exclude the following names  -i   include only the following names
  -F   fix zipfile (-FF try harder) -D   do not add directory entries
  -A   adjust self-extracting exe   -J   junk zipfile prefix (unzipsfx)
  -T   test zipfile integrity       -X   eXclude eXtra file attributes
  -!   use privileges (if granted) to obtain all aspects of WinNT security
  -R   PKZIP recursion (see manual)
  -$   include volume label         -S   include system and hidden files
  -h   show this help               -n   don't compress these suffixes
 

[MMcCarthy]

Hi Rabbit

Thanks for the suggestion.

Not sure how this will help me. Assuming I use it with the shell command, how do I direct the command to the website path and what command do I use to unzip and save contents as?

Mary

[Rabbit]

Hi Rabbit

Thanks for the suggestion.

Not sure how this will help me. Assuming I use it with the shell command, how do I direct the command to the website path and what command do I use to unzip and save contents as?

Mary

How did you do it with winzip? Does winzip let you specify a website path? I thought you were using a separate method to download the file first.

[MMcCarthy]

How did you do it with winzip? Does winzip let you specify a website path? I thought you were using a separate method to download the file first.

No and on testing I'm having a similar problem with winzip. OK so I need a method to download the file from the website. I'll try a straight copy file first and see if that works.

[MMcCarthy]

No and on testing I'm having a similar problem with winzip. OK so I need a method to download the file from the website. I'll try a straight copy file first and see if that works.

OK this is becoming something of a nightmare. I'm having problems with the fact that this is a zip file. I can find a http protocol to use to download it but it was designed for Access and I can't get it to work in Excel. This application has to be in Excel unfortunatley.

This is the protocol I have been trying to use

http://www.mvps.org/access/modules/mdl0037.htm

Every time I try to set a HTTP object I get a "object doesn't support this property or method" error

Dim objHTTP As HTTP
Const conTARGET = "http://www.xxx....somefile.zip?"
 
  Set objHTTP = New HTTP ' error occurs here
 

It works fine in Access btw.

[MMcCarthy]

I'll be around for the next few hours and then I'm away for the weekend. I'll be back sometime on Monday.

Feel free to post any suggestions and I'll address them on my return.

Mary

[puppydogbuddy]

Hi Mary,
See if this link helps, excerpted below;code available at link as noted.
http://answers.google.com/answers/threadview?id=770960

Clarification of Answer by theta-ga on 16 Oct 2006 04:14 PDT
Hi nandun-ga,
You can download the Excel file containing the final code from:
http://rapidshare.de/files/36944619/...Final.xls.html

The following are the major changes made to the code:
- It now logs into the server, submits the form and then
stores the zip file contents that the server returns to it.
- It now waits for Winzip to extract the data.csv file into
the temp folder before it proceeds further.
- It deletes the temp files it created once its done


The logic is quite simple, and the code has comments explaining the
functionality. The logic is as follows:
- Use XmlHttp and send a GET request to the login page (login.asp)
- This will return the session cookie that we extract and store
- Using the session cookie we POST the username and password to
the processlogin.asp page. now we are logged in.
- Using the session cookie, we POST the country and drug data to
the getdata.asp page. Now we have selected the required data.
- Using the session cookie, we send a GET request to the
getdata.asp page. It returns the zip file contents to us.
- We write the returned data in a data.zip file in the temp folder
- We use winzip to extract data.csv from this zip file
- We then open data.csv in text mode and read it line by line,
adding the contents of each line to the Excel Worksheet.
- Once we are done, we delete the zip and csv files.

I am including the code below:

[MMcCarthy]

Thanks pdog. I am not going through a login procedure as this is a public web page. This is the link to the download.

http://www.ecb.int/stats/eurofxref/eurofxref-hist.zip?

I'll check out the code though and see if it helps me out

Thanks

Mary

[MMcCarthy]

OK I'm getting file not found on all the download links for rapidshare.

[MMcCarthy]

BTW, there is an xml version of the file available if that makes life any easier.

http://www.ecb.europa.eu/stats/eurof...f-hist-90d.xml

[MMcCarthy]

OK I'm getting file not found on all the download links for rapidshare.

OK I've found the code.

[puppydogbuddy]

OK I'm getting file not found on all the download links for rapidshare.

Mary,
Here is the code that was printed at the main site:

I am including the code below:
================================================== ==============

Const zipFileName = "data.zip"
Const csvFileName = "data.csv"
 
Sub fetchdata_Click()
 
    Dim fso As Object
    Dim tempFolder As String
    fetchdata.Caption = "Retrieving Data. Please Wait..."
    fetchdata.Enabled = False
 
    On Error GoTo Cleanup
    ' get path to a temp folder where the zip file will be downloaded
    ' and its contents extracted
    Set fso = CreateObject("Scripting.FileSystemObject")
    tempFolder = fso.GetSpecialFolder(2) + "\" + fso.GetTempName + "\"
 
    'Download the zip file
    DownloadZipFile tempFolder + zipFileName
 
    'extract csv file from the zip
    ExtractCsvFile tempFolder + zipFileName, tempFolder
 
    ' Import csv contents. Paste them into the sheet starting 
    ' at the specified cell
    ImportCsvData tempFolder + csvFileName, Range("A1")
 
Cleanup:
    'Delete the tem folder and files we created
    DeleteAllFiles tempFolder
    'Reset the button status
    fetchdata.Caption = "Fetch Data"
    fetchdata.Enabled = True
End Sub
 
Sub DownloadZipFile(zipFileName As String)
  Dim fso As Object
  Dim xmlObj As Object, stream As Object
  Dim strSource As String
  Dim cookie As String
  Set fso = CreateObject("Scripting.FileSystemObject")
  Dim loginPageUrl As String, loginFormUrl As String, dataFormUrl As String
  Dim loginFormData As String, dataFormData As String, responseData As Variant
 
  'If the output folder doesnt exist, create it
  If Not fso.FolderExists(fso.GetParentFolderName(zipFileName)) Then
    MkDir fso.GetParentFolderName(zipFileName)
  End If
 
  loginPageUrl = "https://www.equestionbank.com/login.asp"
  loginFormUrl = "https://www.equestionbank.com/processlogin.asp"
  dataFormUrl = "https://www.equestionbank.com/getdata.asp"
  loginFormData = "userid=guest&password=guest&submit=Login"
  dataFormData = "country=UK&drug=Lipitor&submit=Get%20Data"
 
  'Make a request to get the session cookie
  Call MakeSessionRequest("GET", loginPageUrl, loginFormData, cookie, True)
  'Make a request to submit the login form
  Call MakeSessionRequest("POST", loginFormUrl, loginFormData, cookie)
  'Make a request to submit the data form
  Call MakeSessionRequest("POST", dataFormUrl, dataFormData, cookie)
  'Get the zip file contents from the server
  responseData = MakeSessionRequest("GET", dataFormUrl, dataFormData, cookie)
 
  'Write the returned zip file contents to a file on disk
  Set stream = CreateObject("adodb.stream")
  Const adTypeBinary = 1
  Const adSaveCreateNotExist = 1
  Const adSaveCreateOverWrite = 2
  stream.Type = adTypeBinary
  stream.Open
  stream.Write responseData
  stream.savetofile zipFileName, adSaveCreateOverWrite
  stream.Close
  Set stream = Nothing
  Set xmlObj = Nothing
End Sub
 
Sub ExtractCsvFile(zipFileName As String, outputFolder As String)
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  'Use Winzip to extract the zip file contents
  Shell "C:\progra~1\WinZip\winzip32.exe -min -e -o " + zipFileName + " " _
        + outputFolder
  'Wait for winzip to finish extraction of files
  While Not fso.FileExists(outputFolder + csvFileName)
    DoEvents
  Wend
 
End Sub
 
Sub ImportCsvData(filepath As String, startCell As Range)
   Dim colOffSet As Integer, rowOffset As Integer, i As Integer
   Dim token() As String, fhandle As Integer, fline As String
   'Read the csv file line by line
   'Split line items at a comma
   'Insert each item into a seperate cell
   fhandle = FreeFile()
   Open filepath For Input Access Read Lock Write As #fhandle
 
    While (Not (EOF(fhandle)))
       Line Input #fhandle, fline
       token = Split(Trim(fline), ",")
       For i = 0 To UBound(token)
           startCell.Offset(rowOffset, colOffSet).Value = token(i)
           colOffSet = colOffSet + 1
       Next i
       colOffSet = 0
       rowOffset = rowOffset + 1
    Wend
    Close #fhandle
End Sub
 
' This method uses XmlHttp to make a GET or POST call to the server
' It also optionally extracts the cookie information from the response headers
' It returns the entire response body.
Function MakeSessionRequest(method As String, url As String, data As String, _
 ByRef cookie As String, Optional ByRef updateCookie = False) As Byte()
 
  If Len(cookie) = 0 Then cookie = "dummy=dummy;"
  httpReferrer = Trim(url)
  postVars = Trim(data)
 
  Dim XMLHTTP As Object
 
    Set XMLHTTP = CreateObject("MSXML2.serverXMLHttp")
    XMLHTTP.Open method, Trim(url), False
 
    If UCase(method) = "POST" Then
      XMLHTTP.setRequestHeader "Content-Type", _
                       "application/x-www-form-urlencoded"
    End If
    XMLHTTP.setRequestHeader "Referer", httpReferrer 'in case the server cares
    XMLHTTP.setRequestHeader "Cookie", "to deal with XMLHTTP bug"
    XMLHTTP.setRequestHeader "Cookie", cookie
    XMLHTTP.send postVars
 
    'wait for response
    While XMLHTTP.readyState <> 4
      XMLHTTP.waitForResponse 1000
    Wend
 
    ' extract the cookie data from the response header
    If updateCookie Then
      cookie = ""
      strHeaders = XMLHTTP.getAllResponseHeaders()
      hArr = Split(strHeaders, "Set-Cookie: ")
      For kk = 1 To UBound(hArr)
          theCookie = Left(hArr(kk), InStr(hArr(kk), "path=/") - 2)
          cookie = cookie & " " & theCookie
      Next
    End If
 
    'return the response body
    MakeSessionRequest = XMLHTTP.responseBody
    Set XMLHTTP = Nothing
End Function
 
Public Function DeleteAllFiles(ByVal FolderSpec As String) As Boolean
'Deletes all files in folder specified
'by parameter FolderSpec. Also deletes the folder itself.
'Does not delete subfolders or files within subfolders
Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
 
If oFs.FolderExists(FolderSpec) Then
    Set oFolder = oFs.GetFolder(FolderSpec)
    On Error Resume Next
    For Each oFile In oFolder.Files
        oFile.Delete True 'deletes read-only file also
    Next
    DeleteAllFiles = oFolder.Files.Count = 0
    oFs.DeleteFolder FolderSpec, True
End If
 
End Function

[MMcCarthy]

Thanks for all your help on this. Hopefully, I'll be able to work out what I need. I'll let you know how I get on. Might not be until Tuesday though.

Mary