Macro crea cartella e salva file con nome

[Lyke73]

Ciao a tutti, cercando sul web sono riuscito ad unire due macro in una sola che, come da titolo, crea una cartella e salva il file prendendo per entrambi il nome da due celle diverse, questa è la macro

Codice: Seleziona tutto

Sub CreaCartella()
Dim Cartella As String
Dim FileSystemObj
Set FileSystemObj = CreateObject("Scripting.FileSystemObject")

If Sheets("account").Range("B5") = "" Then
Cartella = "C:\" & Sheets("account").Range("B4")
If Not FileSystemObj.folderExists(Cartella) Then
    FileSystemObj.CreateFolder Cartella
    MsgBox "Attenzione: E' stata creata la nuova Cartella " & Sheets("account").Range("B4") & " nella Directory C:\", vbInformation, "Avviso"
Else
MsgBox "Attenzione: La Cartella " & Sheets("account").Range("B4") & " esiste già!", vbExclamation, "AVVISO"
End If

Sheets("account").Range("B5").Value = "X"

End If
Nomefile = Sheets("account").Range("B3")
Path = "C:\" & Sheets("account").Range("B4") & "\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Path & Sheets("account").Range("B3") & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save

MsgBox "File " & Sheets("account").Range("B3") & " è stato salvato", vbInformation, "AVVISO"

End Sub


La prima volta ha funzionato bene, poi arrivando al punto in cui si salva il file ( questo punto ActiveWorkbook.SaveAs...ecc ecc ) mi restituisce un'errore, riuscite a vedere dove sbaglio?
Allego file http://www.filedropper.com/file1_5

Grazie e buonanotte!

[Lyke73]

Ciao a tutti, mi rispondo da solo.
Facendo della ulteriori prove a mente sveglia ( ?!?!?!? ), se creo il file, chiudo excel e poi lo riapro il salvataggio funziona.
Buona giornata.

[Flash30005]

Eliminerei tutta quella parte che controlla se cartella non esiste e avvisa con messaggio
poi che crea la cartella e avvisa con messaggio
In una macro inviata pochi giorni fa ho usato la classica forma, semplice ed efficace

Codice: Seleziona tutto

perc = ThisWorkbook.Path
If Dir(perc & "\ArchivioXls", vbDirectory) = "" Then
    MkDir (perc & "\ArchivioXls")
End If

Ora devi solo sostituire
Perc con

Codice: Seleziona tutto

Perc = "C:\"

Cartella = Sheets("account").Range("B4")
"\ArchivioXls" con "\" & Cartella

quindi avrai

Codice: Seleziona tutto

perc = "C:\"
Cartella = Sheets("account").Range("B4")
If Dir(perc  & Cartella, vbDirectory) = "" Then
    MkDir (perc & Cartella)
End If
Sheets("account").Range("B5").Value = "X"


poi

Codice: Seleziona tutto

Nomefile = Sheets("account").Range("B3")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Perc  & Cartella & \" & Nomefile & ".xlsm"
Application.DisplayAlerts = True  '<<<< questa la devi rendere true altrimenti hai disabilitato i messaggi di Excel e rimarranno tali fino a che avrai l'applicativo aperto



ciao

[Lyke73]

Ok grazie dei suggerimenti!
Ciao.