Alla fine ci sono riuscito in un modo un po' contorto ma funzionale :

Poi ho aggiunto due macro in un modulo standard
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
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
' DefPath = Application.DefaultFilePath ' questa salva in "Documenti"
DefPath = "C:\Users\Giancarlo\Downloads\Phone_Txt&Excel\"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, "dd-mm-yy")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
On Error Resume Next
MkDir FileNameFolder
On Error GoTo 0
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
Application.DisplayAlerts = False ' Disattiva tutti gli avvisi
' ... il tuo codice VBA qui (es: chiusura file, sovrascrittura, ecc.) ...
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
Application.DisplayAlerts = True
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
enable.events = True
ImportTXT
End Sub
Sub ImportTXT()
Dim nomeFoglio As String
Dim FPath As String ' Percorso della cartella
' 1. Definisci il percorso della cartella e il nome del file
ChatFileNm = Application.GetOpenFilename(filefilter:="Text Files (.txt), >.txt", Title:="Select Chat File To Be Opened")
If ChatFileNm = False Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
SourceSheet = FSO.GetBaseName(ChatFileNm)
Workbooks.OpenText FileName:= _
ChatFileNm, _
Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlTextQualifierNone, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _
TrailingMinusNumbers:=True
' Ottieni il nome del foglio
nomeFoglio = ActiveSheet.Name
Debug.Print nomeFoglio
ChDir "C:\Users\Giancarlo\Downloads\Phone_Txt&Excel"
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\Giancarlo\Downloads\Phone_Txt&Excel\" & nomeFoglio & ".xlsx" _
, FileFormat:=51
ActiveWorkbook.Close
End Sub