運行1004：對象_Workbook的方法另存爲失敗

Question

我有一些問題，Excel宏...

當我運行該腳本，我收到

運行時錯誤1004：方法另存爲對象的_Workbook失敗

一個月前這個宏運行良好....問題在哪裏？

我沒有做一個程序這個劇本，我發現它已經在我的老同事的工作站使用，迄今已給過任何問題....

感謝您的幫助

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

您應該調試strTesto的值。檢查是否不爲空，如果有正確的擴展名（.xlsm）

提示：How to debug in excel