Excel VBA .SaveAs中断

Question

我有一本Excel工作簿，其中包含多个工作表，每个客户1个。 在我的代码中，我试图将每个客户工作表另存为自己的Excel文件。 但是，.SaveAs命令在循环中第二次触发时中断。 任何指针都是很棒的。

Dim SchedWorksheet As Worksheet
Dim SchedWorkbook As Workbook
Dim SchedName As String

Set SchedWorkbook = ActiveWorkbook
Set SchedWorksheet = ActiveSheet
Application.DisplayAlerts = False

For Each Worksheet In SchedWorkbook.Sheets
    If Worksheet.Name = "Instructions" Or Worksheet.Name = "Invoice_Items" 
    Or Worksheet.Name = "Customers" Or _
       Worksheet.Name = "Terms" Or Worksheet.Name = "Dilution_Type" Or 
       Worksheet.Name = "Approval_Status" Or _
       Worksheet.Name = "Carriers" Then
        GoTo NextSched
    End If

    If Worksheet.Name = "Invoices" Then
        'basicScheduleFileName is global set at beginning of program
        SchedName = basicScheduleFileName & "ALL"
    Else
        SchedName = Worksheet.Name
    End If

    'payoutFileName is global set at beginning of program
    Worksheet.SaveAs Application.ActiveWorkbook.Path & "\" & payoutFileName 
    & "\Basic Schedule" & "\" & SchedName, xlOpenXMLWorkbook

NextSched:
Next Worksheet

第二次迭代的错误如下：运行时错误1004'应用程序定义的错误或对象定义的错误'

我还尝试使用SchedWorksheet对象代替Worksheet运行此循环，并在第二次迭代中收到错误“对象_Worksheet对象的方法.SaveAs失败”。

问题我的程序中的代码与他之前的代码极为相似，该代码采用相似的数据集，并使用exportAsFixedFormat调用将每个工作表另存为PDF。 .xlsx是否有等效项？ （.csv也可以）

Answer 1

我不知道“ payOutFileName”的值是什么，所以我将其排除在代码之外。 我也不知道basicScheduleFileName的值，因此将其设置为“ Something”。 您必须将其更改为需要更改的内容。 将其保存到我的目录“ C \\ Files”时，此方法效果很好，可能对您来说有点麻烦。 希望这将是一个开始。

Sub asdfghj()
Dim SchedWorkbook As Workbook
Dim SchedName As String
Dim basicScheduleFileName As String
Dim payoutFileName As String
Dim ws As Worksheet
Dim wb As Workbook

basicScheduleFileName = "Something"
Set SchedWorkbook = ActiveWorkbook
Application.DisplayAlerts = False

For Each ws In SchedWorkbook.Sheets
Debug.Print ws.Name
    If ws.Name = "Instructions" Or ws.Name = "Invoice_Items" _
    Or ws.Name = "Customers" Or _
       ws.Name = "Terms" Or ws.Name = "Dilution_Type" Or _
       ws.Name = "Approval_Status" Or _
       ws.Name = "Carriers" Then
        GoTo NextSched
    End If

    If ws.Name = "Invoices" Then
        SchedName = basicScheduleFileName & "ALL" & ".xlsx"
    Else
        SchedName = ws.Name & ".xlsx"
    End If

    ws.Activate

'    SaveAs Application.ActiveWorkbook.Path & "\" & payoutFileName & "\Basic Schedule" & "\" & SchedName, xlOpenXMLWorkbook

    Set wb = Workbooks.Add
    ws.Copy Before:=wb.Sheets(1)
    wb.Sheets("Sheet1").Delete
    wb.SaveAs Filename:="C:\Files\" & SchedName, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    wb.Close

NextSched:
Next ws



End Sub

Answer 2

首先，感谢所有花费时间和精力尝试解决我的问题的人。 我终于找到了可行的解决方案。
首先，我确保摆脱ActiveWorkbook和ActiveSheet引用，以避免在Excel中造成任何混淆。
其次，正如@NickSlash指出的那样，即使我的代码确实起作用了，它也可能以不同的名称保存同一文件的多个副本。 因此，为了解决该问题，同时解决了原始问题，我更改了代码，将所需的工作表复制到新的工作簿中，并通过以下方式保存它们：

Dim WS As Worksheet
Dim WB As Workbook
Dim NWB As Workbook
Dim SchedName As String

Set WB = Workbooks("Basic_Schedule-.xls")
WB.Activate

'Application.DisplayAlerts = False

For Each WS In WB.Sheets
    WB.Activate

    If WS.Name = "Instructions" Or WS.Name = "Invoice_Items" Or WS.Name = "Customers" Or _
       WS.Name = "Terms" Or WS.Name = "Dilution_Type" Or WS.Name = "Approval_Status" Or _
       WS.Name = "Carriers" Then
        GoTo NextSched
    End If

    If WS.Name = "Invoices" Then
        SchedName = basicScheduleFileName & "ALL" & ".xlsx"
    Else
        SchedName = WS.Name & ".xlsx"
    End If


    'Copy sheet to another WB
    Set NWB = Workbooks.Add
    WB.Activate
    Sheets(WS.Name).Copy After:=NWB.Sheets(NWB.Sheets.Count)
    NWB.Sheets("Sheet1").Delete
    NWB.SaveAs filename:=basicScheduleFilePath & "\" & payoutFileName & "\Basic Schedule" & "\" & SchedName
    NWB.Close
    WB.Activate

NextSched:
Next WS

代替这个：

'Copy sheet to another WB
Set NWB = Workbooks.Add
WB.Activate
Sheets(WS.Name).Copy After:=NWB.Sheets(NWB.Sheets.Count)
NWB.Sheets("Sheet1").Delete
NWB.SaveAs filename:=basicScheduleFilePath & "\" & payoutFileName & "\Basic Schedule" & "\" & SchedName
NWB.Close
WB.Activate

这样做-您可以避免调用“ Activate”方法，并且如果您将WS作为对象进行引用，则当WS已经引用同一工作表时，执行WB.Sheets(WS.Name)是多余的。

'Copy sheet to another WB
WS.Copy '## Creates a new workbook with the copied sheet.
Set NWB = ActiveWorkbook
NWB.SaveAs filename:=basicScheduleFilePath & "\" & payoutFileName & "\Basic Schedule" & "\" & SchedName
NWB.Close