Excel 2003 VBA ошибка 1004 после импорта данных XML
Я построил макрос, который берет разные входные XML-файлы и импортирует каждый из них в отдельную рабочую таблицу в рабочей книге. Затем он сохраняет рабочую книгу. Это работает в 98% случаев с сотнями пользователей, но иногда не удается сохранить книгу с ошибкой 1004: Microsoft Office Excel не может получить доступ к файлу "C:\SymmPiT".
Я обнаружил, что это связано с тем, что один из файлов XML слишком велик для импорта в Excel в разделе "ImportDisks:". Попытка импортировать файл SYMDISK.XML вручную в пустую рабочую книгу (используя "Данные - Импорт - XML") приводит к ошибке Excel "Ошибка импорта XML: некоторые данные не удалось импортировать".
Я пытаюсь, чтобы Excel VBA игнорировал эту ошибку импорта XML. Это работает в макросе на этом этапе, но затем происходит сбой при сохранении книги далее в коде (отмечен красным).
Как я могу избежать "перебоя" в Excel при сохранении файла, даже если есть ошибка импорта? Или можно как-то проверить файл XML перед импортом, чтобы я мог избежать попытки импорта?
Ниже приведены выдержки из кода, большое спасибо за отзывы!:-)
Sub ImportData()
On Error GoTo SPErrorHandler
Application.DisplayAlerts = False
Sheets("SymmPiT").Select
Range("F15").Select
Dim SaveName As String
Dim Section As Integer
ImportDisks:
Section = 7
On Error GoTo ImportLocks
Sheets.Add.Name = "Disks"
Application.ScreenUpdating = False
Range("A2").Select
ActiveCell.FormulaR1C1 = "from symdisk list -v"
If (Dir("C:\SymmPiT\SYMDISK.XML") > "") Then
ActiveWorkbook.XmlImport URL:="C:\SymmPiT\SYMDISK.XML", ImportMap:=Nothing, overwrite:=True, Destination:=Range("$A$4")
ActiveWorkbook.XmlMaps("SymCLI_ML_Map").Delete
Set Contents = Worksheets("Disks").Range("A5")
If Contents.Text = "" Then
MsgBox "Information" & vbNewLine & vbNewLine & "Disks data file has not imported, too many rows of data for Excel 2003"
End If
Else
Range("A4").Select
ActiveCell.FormulaR1C1 = "No Disk Data file SYMDISK.XML found"
End If
Range("A2").Select
Application.ScreenUpdating = True
ImportLocks:
‘ Code continues here, removed from this post….
Application.ScreenUpdating = True
SaveAsExcelFile:
' SaveAsExcelFile
Section = 43
On Error GoTo SPErrorHandler
SaveName = Worksheets("SymmPiT").Range("F19").Text
' Clear any outstanding error
Err.Clear
' Save output file
ActiveWorkbook.SaveAs Filename:="C:\SymmPiT\" & SaveName & ".xls"
Range("F15").Select