Runtime 1004: method saveas of object _workbook failed - vba

Question

I have some problem with Excel macro...
When I run this script I received
error runtime 1004: method save as of object _workbook failed
One month ago this macro worked good.... Where is the problem?
I did not do a program this script, I found it already used in the station of my old colleague, and so far has ever given no problem ....
Thanks for help
Sub StampaVodafone()
Dim i, j As Integer
Dim Fogliotmp As Worksheet
Dim ContoVodafone As String
Dim FoglioElenco As Worksheet
Dim Percorsofile As String
Dim PercorsoSalva As String
Dim ValCell As Variant
Dim strTesto As String
strTesto = "Vuoi procedere con la stampa ?" & vbCr & "SI - Per procedere con la stampa dei dettagli telefonici" & _
vbCr & "NO - Per andare alla procedura successiva"
If MsgBox(strTesto, 68, "Avvio StampaVodafone") = vbYes Then
'Procedura di stampa documenti
i = 1
Do
Set Fogliotmp = ActiveWorkbook.Worksheets(i)
If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Or UCase(Mid(Fogliotmp.Name, 1, 3)) = "LA " Then
'Trovo dove sta la fine pagina
j = 15
ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
Do While (UCase(ValCell) <> "TOTALE COSTI")
j = j + 1
ValCell = Mid(CStr(Fogliotmp.Cells(j, 1).Value), 1, 12)
Loop
With Fogliotmp.PageSetup
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 0
.PrintArea = "$A$1:$P$" & CStr(j)
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Fogliotmp.PrintOut
End If
i = i + 1
Set Fogliotmp = Nothing
Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
MsgBox "Ho terminato di stampare", vbExclamation, "MACRO SONIA"
'Fine procedura stampa
End If
'--
strTesto = "Vuoi procedere con l'estrazione dei file XLSX da spedire agli utenti?" & vbCr & _
"SI - Inizia la generazione dei file XLSX" & vbCr & _
"NO - Termina la macro"
If MsgBox(strTesto, 68, "Genera XLS") = vbYes Then
'Inizio estrazione
Percorsofile = "H:\Vodafone\ElencoCellEstrazione.xlsx"
PercorsoSalva = "H:\Vodafone\Estratti\"
ContoVodafone = Application.ActiveWorkbook.Name
'--
Set FoglioElenco = Workbooks.Open(Percorsofile).Worksheets(1)
'--
i = 1
Do
Windows(ContoVodafone).Activate
Set Fogliotmp = ActiveWorkbook.Worksheets(i)
If UCase(Mid(Fogliotmp.Name, 1, 3)) = "TEL" Then
strTesto = Trim(Mid(Fogliotmp.Name, 4, Len(Fogliotmp.Name)))
'Cerco il nome della persona
j = 2
ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
Do While (UCase(ValCell) <> UCase(strTesto) And UCase(ValCell) <> "END LIST")
j = j + 1
ValCell = Trim(CStr(FoglioElenco.Cells(j, 1).Value))
Loop
If UCase(ValCell) <> "END LIST" Then
'Ho il nome dell'intestatario del telefono
ValCell = Trim(CStr(FoglioElenco.Cells(j, 2).Value))
strTesto = PercorsoSalva & ValCell
'Salvo il documento
Windows(ContoVodafone).Activate
Sheets(Fogliotmp.Name).Select
Sheets(Fogliotmp.Name).Copy
ActiveWorkbook.SaveAs Filename:=strTesto, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Windows(ContoVodafone).Activate
End If
End If
'--
i = i + 1
Set Fogliotmp = Nothing
Windows(ContoVodafone).Activate
Loop While (i < ActiveWorkbook.Worksheets.Count + 1)
MsgBox "Ho terminato gli export XlsX", vbExclamation, "MACRO SONIA"
End If
End Sub

Answer 1

You should debug the value of strTesto. Check if it's not null and if it has the extension correct (.xlsm)
TIP: How to debug in
excel