Vba changes to be made

varadhan88 · Jan 7th 2017

Below VBA CODE working properly to extract data from zip file if my zip file presents in C:\Users\max\Downloads..
i.e if i import data , it unzip the zipped file and copy the csv data inside zip file and paste it in the workbook which i need, but the problem is "fo26DEC2016bhav.csv.zip" zip name will change daily ,and i need to download the data and update it , in my workbook worksheet, so my vba code has to be changed as per it can daily update data irrespective of zip name and worksheet name in my workbook, so kindly help me to correct

Code

Sub ImportDailyData()
Dim strFileName As String, str7ZIP As String, strZipFile As String, strDestinationFolder As String, strCMD As String 
Dim WshShell As Object, fso As Object 
Dim WB As Workbook 
Dim ThisWB As Workbook 
Dim WS As Worksheet 
Dim ThisWS As Worksheet 
 
strFileName = "fo26DEC2016bhav.csv" 
str7ZIP = "C:\Program Files (x86)\7-Zip\7z.exe" 
strDestinationFolder = ActiveWorkbook.Path 
strZipFile = strDestinationFolder & "\fo26DEC2016bhav.csv.zip" 
Set ThisWB = ActiveWorkbook 
 
If Right(strDestinationFolder, 1) <> "" Then strDestinationFolder = strDestinationFolder & "" 
 
Set WshShell = CreateObject("Wscript.Shell") 
Set fso = CreateObject("Scripting.FileSystemObject") 
 
If Not fso.FileExists(str7ZIP) Then 
    MsgBox "Could not find 7-Zip:  " & vbCrLf & vbCrLf & str7ZIP, vbExclamation, "fo26DEC2016bhav.csv" 
    Exit Sub 
End If 
 
strCMD = Chr(34) & str7ZIP & Chr(34) & " e -i!" & _ 
Chr(34) & strFileName & Chr(34) & " -o" & _ 
Chr(34) & strDestinationFolder & Chr(34) & " " & _ 
Chr(34) & strZipFile & Chr(34) & " -y" 
 
 
WshShell.Run strCMD, 0, True 
 
If Not fso.FileExists(strDestinationFolder & strFileName) Then 
    MsgBox "Failed to get file:  " & strDestinationFolder & strFileName, vbExclamation, "fo26DEC2016bhav.csv" 
    Exit Sub 
Else 
    '---> Stop Events
    With Application 
        .EnableEvents = False 
        .ScreenUpdating = False 
        .DisplayAlerts = False 
    End With 
     
    '---> Open the Import Workbook
    Set WB = Workbooks.Open(strDestinationFolder & strFileName) 
     
     [COLOR=darkgreen]'---> Clean Current Data in present workbook[/COLOR]
    For Each WS In ThisWB.Worksheets 
        If WS.Name <> "Main" Then 
            WS.UsedRange.EntireRow.Delete 
        End If 
    Next WS 
    '---> Get Data
    For Each WS In WB.Worksheets 
        Set ThisWS = ThisWB.Worksheets(WS.Name) 
        WS.UsedRange.Copy ThisWS.Range("A1") 
        ThisWS.UsedRange.EntireColumn.AutoFit 
    Next WS 
     
    '---> Close WB
    Application.DisplayAlerts = False 
    WB.Close savechanges:=False 
    Kill strDestinationFolder & strFileName 
    Application.DisplayAlerts = True 
     
    '---> Clean Variables
    Set WB = Nothing 
    Set WS = Nothing 
     
    '---> Enable Events
    With Application 
        .EnableEvents = True 
        .ScreenUpdating = True 
        .DisplayAlerts = True 
    End With 
     
    '---> Advise user
    MsgBox ("Import Daily data successfull.") 
End If 
 
End Sub

Display More

below is zip file and have upload my excel file

https://www.nseindia.com/conte…C/fo26DEC2016bhav.csv.zip

my excel file

I have asked same question in this forum too.
http://www.vbaexpress.com/foru…elp-me-to-correct-the-vba

dangelor · Jan 7th 2017

Re: Vba changes to be made

Could you use the GetOpenFilename method to assign the zip file name to a variable?

Code

Dim strZipFileToOpen As String
    strZipFileToOpen = Application.GetOpenFilename("zip Files (*.zip), *.zip")
    strZipFile = strDestinationFolder & "\" & strZipFileToOpen

varadhan88 · Jan 8th 2017

Re: Vba changes to be made

I cant understand i need to change those lines from where

nikolassor · Jan 8th 2017

Re: Vba changes to be made

Something like this maybe?

Code

strFileName = Application.GetOpenFilename("zip Files(*.zip),*.zip")
    'strFileName = "fo26DEC2016bhav.csv"
    
    str7ZIP = "C:\Program Files (x86)\7-Zip\7z.exe"
    strDestinationFolder = ActiveWorkbook.Path
    
    strZipFile = strDestinationFolder & "\" & strFileName
    'strZipFile = strDestinationFolder & "\fo26DEC2016bhav.csv.zip"

Just changed the 'strFileName' and 'strZipFile' lines

dangelor · Jan 8th 2017

Re: Vba changes to be made

The GetOpenFileName method is explained here: http:////msdn.microsoft.com/en-us/library/office/ff834966.aspx

It works in your code just as you would open a file, except that it just gets the name of the file you wish to open, but does not open it.

My earlier reply was just a suggestion as to how it could be implemented in your existing subroutine.

nikolassor · Jan 9th 2017

Re: Vba changes to be made

Yes but he could set his zip name that way. If it is always changing. Just for a method not to have retyping his code all the time.
Right?

varadhan88 · Jan 9th 2017

Re: Vba changes to be made

any new easy code???

dangelor · Jan 9th 2017

Re: Vba changes to be made

From the level of expertise needed to write your code as it is now, I assumed you would be able to incorporate the needed changes. With that said, try this untested modification...

Code

Sub ImportDailyData()
    Dim strFileName As String
    Dim str7ZIP As String
    Dim strZipFile As String
    Dim strDestinationFolder As String
    Dim strCMD As String
    Dim WshShell As Object
    Dim fso As Object
    Dim WB As Workbook
    Dim ThisWB As Workbook
    Dim WS As Worksheet
    Dim ThisWS As Worksheet
    Dim strZipFileToOpen As String
    
    str7ZIP = "C:\Program Files (x86)\7-Zip\7z.exe"
    strZipFileToOpen = Application.GetOpenFilename("zip Files (*.zip), *.zip")
    strZipFile = strDestinationFolder & "\" & strZipFileToOpen
    
    strFileName = Left(strZipFileToOpen, Len(strZipFileToOpen) - 4)
    strDestinationFolder = ActiveWorkbook.Path
    Set ThisWB = ActiveWorkbook
    
    If Right(strDestinationFolder, 1) <> "" Then strDestinationFolder = strDestinationFolder & ""
    
    Set WshShell = CreateObject("Wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FileExists(str7ZIP) Then
        MsgBox "Could not find 7-Zip:  " & vbCrLf & vbCrLf & str7ZIP, vbExclamation, strFileName
        Exit Sub
    End If
    
    strCMD = Chr(34) & str7ZIP & Chr(34) & " e -i!" & _
    Chr(34) & strFileName & Chr(34) & " -o" & _
    Chr(34) & strDestinationFolder & Chr(34) & " " & _
    Chr(34) & strZipFile & Chr(34) & " -y"
    
    
    WshShell.Run strCMD, 0, True
    
    If Not fso.FileExists(strDestinationFolder & strFileName) Then
        MsgBox "Failed to get file:  " & strDestinationFolder & strFileName, vbExclamation, strFileName
        Exit Sub
    Else
        '---> Stop Events
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
            .DisplayAlerts = False
        End With
        
        '---> Open the Import Workbook
        Set WB = Workbooks.Open(strDestinationFolder & strFileName)
        
        [COLOR=darkgreen] '---> Clean Current Data in present workbook[/COLOR]
        For Each WS In ThisWB.Worksheets
            If WS.Name <> "Main" Then
                WS.UsedRange.EntireRow.Delete
            End If
        Next WS
        '---> Get Data
        For Each WS In WB.Worksheets
            Set ThisWS = ThisWB.Worksheets(WS.Name)
            WS.UsedRange.Copy ThisWS.Range("A1")
            ThisWS.UsedRange.EntireColumn.AutoFit
        Next WS
        
        '---> Close WB
        Application.DisplayAlerts = False
        WB.Close savechanges:=False
        Kill strDestinationFolder & strFileName
        Application.DisplayAlerts = True
        
        '---> Clean Variables
        Set WB = Nothing
        Set WS = Nothing
        
        '---> Enable Events
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
            .DisplayAlerts = True
        End With
        
        '---> Advise user
        MsgBox ("Import Daily data successful.")
    End If
    
End Sub

Display More

Vba changes to be made

Participate now!

Share