tags:

views:

156

answers:

0

Hi,

I built an macro which takes different XML input files and imports each one into a different worksheet in a workbook. It then saves the workbook. This works a treat 98% of the time with hundreds of users, but sometimes fails when saving the workbook with "Error 1004: Microsoft Office Excel cannot access the file 'C:\SymmPiT'.

I found it relates to when one of the XML files is too large for Excel to import in section "ImportDisks:". Trying to import the SYMDISK.XML file manually into a blank workbook (using "Data - Import - XML") brings Excel error "XML Import Error: Some Data failed to import".

I am trying to have Excel VBA ignore this XML import error. This works in the macro at that stage but then fails when saving the workbook further down in the code (marked in red).

How can I avoid Excel "barfing" when saving the file, even if there is an import error? Or can the XML file be checked somehow before importing so I can avoid trying the import?

Code exceprts are below, many thanks for responses! :-)

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