Help me to correct the vba

[vjvijay88]

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


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)

'---> Clean Current Data in present workbook
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

below is zip file and have upload my excel file "REMOVE SPACE BETWEEN THEM"


https ://www . nseindia . com/content/historical/DERIVATIVES/2016/DEC/fo26DEC2016bhav.csv. zip
my excel file

[offthelip]

Have a look at this thread which is very similar:

http://www.vbaexpress.com/forum/showthread.php?58161-Open-workbook-with-dynamic-filename

Your problem is easier because the name changes every day rather than once a week.

[vjvijay88]

thanks sir