
Originally Posted by
mdmackillop
Try this version
Awesome ! This one did the trick for CSV_YYYY_QX_DIGITS_DIGITS.zip beside a small folder issue (see below in bold)! Thanks a lot, I'm reaching closer to my goal !
Do you think its possible to amend the code with an If function if zip fname format is MTH_DD_YYY_HH_MM_SS_email"at"email.com.zip, unzip in temporary folder and then unzip the CSV_YYYY_QX_DIGITS_DIGITS.zip ?
See below in bold:
Option Explicit
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim Pth As String
Dim f As Variant, f1, f2, Dt, Nm
Dim fld As String
Dim TgtNameFolder As String
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
Application.ScreenUpdating = False
Pth = Left(Fname, InStr(4, Fname, "\"))
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
DefPath = Pth
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
FileNameFolder = DefPath & "tmp" & "\"
'Make the normal folder in DefPath
On Error Resume Next
MkDir FileNameFolder
On Error GoTo 0
'Create the targetfolder name the folder still shows up inside the w:\zip_depository\patched_depository instead of w:\patched_depository
TgtNameFolder = DefPath & "patched_depository" & "\"
'Make the normal folder in DefPath
On Error Resume Next
MkDir TgtNameFolder
On Error GoTo 0
'Extract the files into the newly created tmp folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'Create folder based on filename (CSV_YYYY_QX_DIGITS_DIGITS.zip)
f = Dir(DefPath & "tmp" & "\*.csv")
f1 = InStr(1, f, "_") + 1
f2 = InStrRev(f, "_")
Dt = Mid(f, 1, f1 - 2)
Nm = Mid(f, f1, f2 - f1)
fld = Dt & "_" & Nm
'Can the formula create a temporary folder for zip based on its filename (MTH_DD_YYY_HH_MM_SS_email"at"email.com.zip) and then extract fname CSV_YYYY_QX_DIGITS_DIGITS.zip?
f= Dir(DefPath & "tmp" & "\*.csv")
f1 = InStr(1, f, "_") + 1
f2 = InStrRev(f, "_")
Dt = Mid(f, 1, f1 - 2)
Nm = Mid(f, f1, f2 - f1)
fld = Dt & "_" & Nm
'Make the target folder in DefPath
On Error Resume Next
MkDir TgtNameFolder & fld
On Error GoTo 0
Call DoStuff(fld, DefPath & "tmp", TgtNameFolder & fld)
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Left(FileNameFolder, Len(FileNameFolder) - 1), True
End If
Application.ScreenUpdating = True
Shell "Explorer.exe " & TgtNameFolder, vbNormalFocus
End Sub
End Sub