VBC Excel to find latest creation date zip within folder, then open CSV file embedded

[ChrisAch]

Hi All

I been searching the net that vaguely represents my requirements, but am unable to find in order to adapt, or work accordingly.

What I am trying to do:

Find said folder
Find latest creation date zip file
Open Zip file
Open CSV file within zipped folder

Any help to set me on my way would be kindly appreciated.

I have tried some of the coding that others have posted elsewhere in relation to finding latest file etc.

Thanks.

[Leith Ross]

Hello ChrisAch,

Are you searching a single folder to find the most recent zipped file or do you want to search all the sub-folders also?

Will there be only a single CSV file in the zipped file?

Will you need to check if a zipped file contains other zipped files?

[ChrisAch]

Hi Leith

Thank you for your response.

so it will be one folder, but each hour a new zip will be added to this folder.

so effectively it will only be one folder to look up
so the latest zip file that has been created within the folder.
then there will only be one csv file within the zip

Hope that clarifies

[Kenneth Hobs]

Change paths and add the two references as commented. Delete the test subs as you like.

Sub OpenMostRecentZipFilesCSVFile()
Dim d As String, f As String
Dim a() As String
Dim objShell As Shell, objFolder As Shell32.Folder


d = "X:\MSWord\MailMerge\"
f = "*.zip"
f = NewestFile(d, f)
If f = "" Then Exit Sub

a() = ZipContentsToArray(d & f)
a() = Filter(a(), ".csv", True, vbTextCompare)
'MsgBox Join(a(), vbLf), vbInformation, UBound(a)
If UBound(a) = -1 Then Exit Sub

On Error Resume Next
Kill Environ("temp") & "\" & a(0)
Set objShell = New Shell
objShell.Namespace(Environ("temp")).CopyHere objShell.Namespace(d).Items.Item(a(0))
Workbooks.Open (Environ("temp") & "\" & a(0))
End Sub




Sub Test_NewestFile()
Dim d As String, f As String
d = "X:\MSWord\MailMerge\"
f = "*.zip"
MsgBox NewestFile(d, f)
End Sub


'http://spreadsheetpage.com/index.php/tip/identifying_the_newest_file_in_a_directory/
Function NewestFile(Directory, filespec) As String
' Returns the name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"


FileName = Dir(Directory & filespec, 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
NewestFile = MostRecentFile
End Function


Sub Test_ZipContentsToArray()
Dim a() As String
a() = ZipContentsToArray(Environ("temp") & "\MediaFileExistsInSheet.zip")
MsgBox Join(a(), vbLf)
End Sub


Rem Needs Tools > References..., add: Microsoft Shell Controls and Automation
Rem Needs Tools > References..., add: Microsoft Scripting Runtime
Function ZipContentsToArray(zipFile As String) As Variant
Dim objShell As Shell, objFolder As Shell32.Folder, objFolderItem As FolderItem
Dim zipPath As String, sArray() As String
Dim FSO As FileSystemObject


Set FSO = New FileSystemObject
With FSO
If Not .FileExists(zipFile) Then
MsgBox zipFile, vbCritical, "File Does Not Exists"
Exit Function
End If
zipPath = .GetParentFolderName(zipFile)
zipFile = .GetFileName(zipFile)
End With

Set objShell = New Shell
Set objFolder = objShell.Namespace(zipPath)
Set objFolderItem = objFolder.ParseName(objFolder.ParseName(zipFile))
'Set objFolderItem = objFolder.ParseName(zipFile)
sArray() = Split(objFolder.GetDetailsOf(objFolderItem, -1), vbLf)
ZipContentsToArray = sArray()
End Function

[ChrisAch]

That's great.

Thank you for your help, I tweaked it a little, and managed to suss what I wanted.

Thank you kindly for your expert advice.



Change paths and add the two references as commented. Delete the test subs as you like.

Sub OpenMostRecentZipFilesCSVFile()
Dim d As String, f As String
Dim a() As String
Dim objShell As Shell, objFolder As Shell32.Folder


d = "X:\MSWord\MailMerge\"
f = "*.zip"
f = NewestFile(d, f)
If f = "" Then Exit Sub

a() = ZipContentsToArray(d & f)
a() = Filter(a(), ".csv", True, vbTextCompare)
'MsgBox Join(a(), vbLf), vbInformation, UBound(a)
If UBound(a) = -1 Then Exit Sub

On Error Resume Next
Kill Environ("temp") & "\" & a(0)
Set objShell = New Shell
objShell.Namespace(Environ("temp")).CopyHere objShell.Namespace(d).Items.Item(a(0))
Workbooks.Open (Environ("temp") & "\" & a(0))
End Sub




Sub Test_NewestFile()
Dim d As String, f As String
d = "X:\MSWord\MailMerge\"
f = "*.zip"
MsgBox NewestFile(d, f)
End Sub


'http://spreadsheetpage.com/index.php/tip/identifying_the_newest_file_in_a_directory/
Function NewestFile(Directory, filespec) As String
' Returns the name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"


FileName = Dir(Directory & filespec, 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
NewestFile = MostRecentFile
End Function


Sub Test_ZipContentsToArray()
Dim a() As String
a() = ZipContentsToArray(Environ("temp") & "\MediaFileExistsInSheet.zip")
MsgBox Join(a(), vbLf)
End Sub


Rem Needs Tools > References..., add: Microsoft Shell Controls and Automation
Rem Needs Tools > References..., add: Microsoft Scripting Runtime
Function ZipContentsToArray(zipFile As String) As Variant
Dim objShell As Shell, objFolder As Shell32.Folder, objFolderItem As FolderItem
Dim zipPath As String, sArray() As String
Dim FSO As FileSystemObject


Set FSO = New FileSystemObject
With FSO
If Not .FileExists(zipFile) Then
MsgBox zipFile, vbCritical, "File Does Not Exists"
Exit Function
End If
zipPath = .GetParentFolderName(zipFile)
zipFile = .GetFileName(zipFile)
End With

Set objShell = New Shell
Set objFolder = objShell.Namespace(zipPath)
Set objFolderItem = objFolder.ParseName(objFolder.ParseName(zipFile))
'Set objFolderItem = objFolder.ParseName(zipFile)
sArray() = Split(objFolder.GetDetailsOf(objFolderItem, -1), vbLf)
ZipContentsToArray = sArray()
End Function

[ChrisAch]

Hi Forum

Can anyone assist, I am trying to open latest zip file using the code below as advised by the board previously. I thought I had followed the advice, however I when I run the below I receive a compile error ''user defined' type not defined''

I am guessing its shell 32?

Im just wondering what I am doing wrong?

I am wanting to open up example shell location ''ABC folder'' find latest date modified zip, and then extract and open the csv file within. I do not need to save the extracted file, as I will be renaming it and saving to a different location after I have extracted what I need.

Any help on this is appreciated.


Sub OpenCSV()
Dim d As String, f As String
Dim a() As String
Dim objShell As Shell, objFolder As Shell32.Folder


d = "\\ABCFOLDER\ (file://\\ABCFOLDER\)"
f = "*.zip"
f = NewestFile(d, f)
If f = "" Then Exit Sub

a() = ZipContentsToArray(d & f)
a() = Filter(a(), ".csv", True, vbTextCompare)
'MsgBox Join(a(), vbLf), vbInformation, UBound(a)
If UBound(a) = -1 Then Exit Sub

On Error Resume Next
Kill Environ("temp") & "\" & a(0)
Set objShell = New Shell
objShell.Namespace(Environ("temp")).CopyHere objShell.Namespace(d).Items.Item(a(0))
Workbooks.Open (Environ("temp") & "\" & a(0))


End Sub

[snb]

I'd suggest:


Sub M_snb_Unzip_CSV()
sn = Array("G:\OF\", "G:\", "") ' source directory / destination directory

sn(2) = sn(0) & Split(CreateObject("wscript.shell").exec("cmd /c dir """ & sn(0) & "*.zip"" /b/o-d").stdout.readall, vbCrLf)(0)

With CreateObject("Shell.Application")
.Namespace(sn(1)).CopyHere .Namespace(sn(2)).items.Item(0)
sn(2) = sn(1) & .Namespace(sn(2)).items.Item(0)
End With

Workbooks.Open sn(2)
End Sub

[ChrisAch]

Hi Snb

thanks.

so I changed the source and destination as per below, and row two come up as a runtime error.

Any ideas why that might be?

Thank you.


Sub M_snb_Unzip_CSV()
sn = Array("ABC", "ABC", "") ' source directory / destination directory

sn(2) = sn(0) & Split(CreateObject("wscript.shell").exec("cmd /c dir """ & sn(0) & "*.zip"" /b/o-d").stdout.readall, vbCrLf)(0)

With CreateObject("Shell.Application")
.Namespace(sn(1)).CopyHere .Namespace(sn(2)).items.Item(0)
sn(2) = sn(1) & .Namespace(sn(2)).items.Item(0)
End With

Workbooks.Open sn(2)
End Sub

[Kenneth Hobs]

ABC is not a folder. Be sure to add the backslash character for both the folders.

[snb]

"ABC" isn't a directory

But this code is sufficient:


Sub M_snb()
c00 = "G:\OF\"

c00 = c00 & Split(CreateObject("wscript.shell").exec("cmd /c dir """ & c00 & "*.zip"" /b/o-d").stdout.readall, vbCrLf)(0)

with CreateObject("Shell.Application")
.ShellExecute .Namespace(c00).items.Item(0), "open"
end with
End Sub

[ChrisAch]

Apologies chaps, I put ABC as an example.

I changed to the correct directory, and your right, it was the backslash, that was causing a problem.


The code now extracts, however 'code executed has been interrupted' here >>


Apologies chaps, I put ABC as an example.

I changed to the correct directory, and your right, it was the backslash, that was causing a problem.


The code now extracts, however 'code executed has been interrupted' here >>

[CODE]sn(2) = sn(1) & .Namespace(sn(2)).Items.Item(0)

Not sure what would cause the interruption?

Apologies

Not sure what would cause the interruption?

Apologies

[mdmackillop]

Not your fault. It seems to start if you halt code execution repeatedly. If you want to part test code, use Exit Sub to get out of the run "properly"; it might help. See google results here (https://www.google.co.uk/search?q=code+execution+has+been+interrupted&oq=code+execution+has+been+interrupted&aqs=chrome..69i57.11480j0j4&sourceid=chrome&ie=UTF-8). I usually end up rebooting to get rid of it.
This (https://optionexplicitvba.com/2013/08/22/the-two-worst-excel-errors-ever/) sums up my experience also

[snb]

You will not get that message using:


Sub M_snb()
c00 = "G:\OF\"

c00 = c00 & Split(CreateObject("wscript.shell").exec("cmd /c dir """ & c00 & "*.zip"" /b/o-d").stdout.readall, vbCrLf)(0)

With CreateObject("Shell.Application")
.ShellExecute .Namespace(c00).items.Item(0), "open"
End With
End Sub

But you can always click 'continue'.

[ChrisAch]

Guys that works perfectly.

Thank you so much for your great knowledge.

tank you again

[snb]

You can even reduce the code to:


Sub M_snb()
c00 = "G:\OF\"

With CreateObject("Shell.Application")
.ShellExecute .Namespace(c00 & Split(CreateObject("wscript.shell").exec("cmd /c dir """ & c00 & "*.zip"" /b/o-d").StdOut.ReadAll, vbCrLf)(0)).Items.Item(0), "open"
End With
End Sub

[ChrisAch]

Just to further add a different scenario....

I have adapted some code off the net as such:


Dim MyPath As String
' Dim MyFile As String
' Dim LatestFile As String
' Dim LatestDate As Date
' Dim LMD As Date
'
' 'Specify the path to the folder
' MyPath = "\\Example directory (file://\\Example directory)\"
'
' 'Make sure that the path ends in a backslash
' If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'
' 'Get the first Excel file from the folder
' MyFile = Dir(MyPath & "*.csv", vbNormal)
'
' 'If no files were found, exit the sub
' If Len(MyFile) = 0 Then
' MsgBox "No files were found...", vbExclamation
' Exit Sub
' End If
'
' 'Loop through each Excel file in the folder
' Do While Len(MyFile) > 0
'
' 'Assign the date/time of the current file to a variable
' LMD = FileDateTime(MyPath & MyFile)
'
' 'If the date/time of the current file is greater than the latest
' 'recorded date, assign its filename and date/time to variables
' If LMD > LatestDate Then
' LatestFile = MyFile
' LatestDate = LMD
' End If
'
' 'Get the next Excel file from the folder
' MyFile = Dir
'
' Loop
'
' 'Open the latest file
' Workbooks.Open MyPath & LatestFile


The expected outcome is within my sample directory, a newly created folder is dumped in this directory. Therefore the name of that folder changes daily.

I am wanting to take the last created folder, and open the 1 csv file that is stored within the last folder created.

If anyone can advise where I am going wrong that would be appreciated.

Thanks.

[snb]

Why do you ignore the suggestions you got in this thread ?

[ChrisAch]

Apologies, I didn't realise I had!

To be fair, the question relates to the thread , and also is a variation of the above, that I thought had not been covered above.

The above examples, and answers have kindly related (as far as I understand) to going to a particular set directory and finding the latest file and opening.

My latest question, is ... Any ideas if a new folder is generated in the directory, and how to open the latest folder and then extract the csv within.

if I run the above examples I believe it will not work, as the folder is locked in the code, rather than sophisticated to recognise a new folder is to be found and opened.

Hope that clarifies, and I hope I have not overlooked what has already been said above.

Please feel free to correct me if that's the case!

Thanks.

[snb]

Are you still talking about a zip file or has your question turned into a csv file ?