Try this version
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
        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
        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




Sub DoStuff(fld, tmp, Pth)
    Dim wb As Workbook, csv As Workbook, f
    Dim f1, f2, sht
    Set wb = Workbooks.Add
    wb.SaveAs Filename:=Pth & "\" & fld & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    
    f = Dir(tmp & "\*.csv")
    Do
        Set csv = Workbooks.Open(Filename:=tmp & "\" & f)
        csv.Sheets(1).Copy after:=wb.Sheets(wb.Sheets.Count)
        csv.Close False
        Kill tmp & "\" & f 'CSV
        'Sheet name
        f1 = InStrRev(f, "_") + 1
        f2 = InStrRev(f, ".")
        sht = Mid(f, f1, f2 - f1)
        ActiveSheet.Name = sht
        f = Dir
    Loop Until f = ""
    
    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    wb.Close True
    Application.DisplayAlerts = False
End Sub