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

0 ответов

Другие вопросы по тегам