SaveAs Macro Save Failed

[crburke92]

I have the following code built to copy templates and export them based off a cell reference. It works 99% of the time but periodically fails to save. There does not seem to be any consistency to it which is odd. The code is as follows.

Sub NewExportAllSheets()

Dim FilePath As String
Dim FileName As String
Dim Directory As String

Dim Tp As Range
Dim List As Range
Dim Name As Range

Dim NewWB As Workbook
Dim Sheet As Worksheet
Dim ExpList As Worksheet
Dim Copy As Worksheet

Dim Total As Integer
Dim FD As Office.FileDialog

Set ExpList = Sheets("ExportList")
Set Tp = ExpList.Range("E2:E100")
Set List = ExpList.Range("F2:F100")
Set Name = ExpList.Range("G2:G100")
Set FD = Application.FileDialog(msoFileDialogFolderPicker)

'Filedialog selection
With FD
    .AllowMultiSelect = False
    .Title = "Please select the destination folder."
    .Show
        If (.SelectedItems.Count = 0) Then GoTo Whoops
FilePath = .SelectedItems(1)

End With

ScreenUpdating = False
Application.DisplayAlerts = False

'Loop it
For Each SN In List
    For i = 2 To 10000
        If ExpList.Range("E" & i) = "" Then GoTo SheDone
        
            FileName = ExpList.Range("G" & i)
            Set NewWB = Workbooks.Add
              
              If Workbooks("ClientDatabase").Sheets("ExportList").Range("E" & i) = "HVBREAKER" Then
                Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKER_TEMP").Visible = True
                    Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKER_TEMP").Copy After:=Workbooks("ClientDatabase").Sheets("ExportList")
                    Set Copy = ActiveSheet
                        With Copy
                            .Name = Sheets("ExportList").Range("G" & i)
                            .Range("G10") = Workbooks("ClientDatabase").Sheets("ExportList").Range("G" & i)
                            .Range("G12") = Workbooks("ClientDatabase").Sheets("ExportList").Range("F" & i)
                            .Range("G10:M10").Merge
                            .Range("G12:M12").Merge
                            .Range("A10:AJ15").Copy
                            .Range("A10").PasteSpecial Paste:=xlPasteValues
                            .Range("A1:AJ3").Copy
                            .Range("A1").PasteSpecial Paste:=xlPasteValues
                            .Move After:=NewWB.Sheets("Sheet1")
                        End With
                        Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKER_TEMP").Visible = False
                        
              ElseIf Workbooks("ClientDatabase").Sheets("ExportList").Range("E" & i) = "HVBREAKERTIMING" Then
                Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKERTIMING_TEMP").Visible = True
                    Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKERTIMING_TEMP").Copy After:=Workbooks("ClientDatabase").Sheets("ExportList")
                    Set Copy = ActiveSheet
                        With Copy
                            .Name = Sheets("ExportList").Range("G" & i)
                            .Range("G10") = Workbooks("ClientDatabase").Sheets("ExportList").Range("G" & i)
                            .Range("G12") = Workbooks("ClientDatabase").Sheets("ExportList").Range("F" & i)
                            .Range("G10:M10").Merge
                            .Range("G12:M12").Merge
                            .Range("A10:AJ15").Copy
                            .Range("A10").PasteSpecial Paste:=xlPasteValues
                            .Range("A1:AJ3").Copy
                            .Range("A1").PasteSpecial Paste:=xlPasteValues
                            .Range("A68:AJ88").Copy
                            .Range("A68").PasteSpecial Paste:=xlPasteValues
                            .Move After:=NewWB.Sheets("Sheet1")
                        End With
                        Workbooks("ClientDatabase").Sheets("HVCIRCUITBREAKERTIMING_TEMP").Visible = False
                        
            End If
NewWB.Sheets("Sheet1").Delete
NewWB.SaveAs FilePath & "\" & FileName & ".xlsx"
NewWB.Close
Next
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End

SheDone:
    Workbooks("ClientDatabase").Sheets("ExportList").Range("A2:JG100").ClearContents
    Workbooks("ClientDatabase").Sheets("ClientDatabase").Activate
        MsgBox ("Export Complete")
            Exit Sub
Whoops:
    MsgBox ("Action Canceled")
End Sub

There are 32 ElseIf statements based on what sheet is being copied. I removed them for ease of viewing but they're all redundant.

Some things to note are my company does work off OneDrive. I have had this error occur both online AND offline. I have also had it work fine both online AND offline.

The origin file all sheets are made from is a .xlsm. I have had this error trying to save as a .xls, .xlsx, and .xlsm. One thing I wasnt sure about was if it's a due to the extension type of the new file that opens compared to where all the origin templates are coming from? I'm new to using the .SaveAs function so any clarity would be awesome! TIA

 

[rlv01]

Your For I = 2 To 10000 loop will create 9998 files. When you are saving files in rapid succession like that you have to allow time for the file operation to complete. Try adding a DoEvents statement at the bottom of the loop.

            End If
            NewWB.Sheets("Sheet1").Delete
            NewWB.SaveAs FilePath & "\" & FileName & ".xlsx"
            NewWB.Close
            Set NewWB = Nothing
            DoEvents
        Next
    Next

 

[crburke92]

Your For I = 2 To 10000 loop will create 9998 files. When you are saving files in rapid succession like that you have to allow time for the file operation to complete. Try adding a DoEvents statement at the bottom of the loop.

            End If
            NewWB.Sheets("Sheet1").Delete
            NewWB.SaveAs FilePath & "\" & FileName & ".xlsx"
            NewWB.Close
            Set NewWB = Nothing
            DoEvents
        Next
    Next

I did mean to change that to a lot lower of a number, but at the top, once E & i = "" it ends the loop. It only ever makes as many files as are required which is generally 1-10, but could be as high as 30-40. I'll definitely add the DoEvents function though, thanks for the insight there!