perform custom action when error occurs 1

[ch4meleon]

I have some code that was v helpfully given (thread705-1142361) to import excel files into a database for me (see below) which ran perfectly last quarter, however now i am getting an error as someone has changed the format of their file before sending it to me so it wont import.
as i have 600 files and i dont know which ones have been changed I would like to put something into the error handling bit of the vba that says when the code comes accross a file it cant import pop up a msgbox with the file name and then go onto the next file or alternatively, something that records all bad file names in a table as it finds them and then automatically skips the bad one and tries to import the next one

code -


'This shall find all excel files named File_Name in folder Search_Folder

Function Searching4Excels(ByVal Search_Folder As String)
'ByVal File_Name As String
With Application.FileSearch
.NewSearch
.FileType = 4 'msoFileTypeExcelWorkbooks
'.Filename = File_Name & "*.xls"
.LookIn = Search_Folder
.SearchSubFolders = False
If .Execute > 0 Then
For iCount = 1 To .FoundFiles.Count
'LBound(.FoundFiles) To UBound(.FoundFiles)
Call ImportThisExcel(.FoundFiles(iCount))
Next iCount
Else
MsgBox "No file found in " & Search_Folder, vbCritical + vbOKOnly, "Importing Excels"
End If
End With
End Function


Sub ImportThisExcel(ByVal FilePathName As String)

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "imported quarterly data", FilePathName, True

End Sub

Any help very much apriciated

 

[Golom]

Here's the general scheme. You will need to determine the error number(s) returned when the import fails.

Function Searching4Excels(ByVal Search_Folder As String)
    [COLOR=blue]
    On Error GoTo BadImport
    Dim ImportFileName      As String
    [/color]                        
    With Application.FileSearch
        .NewSearch
        .FileType = 4           'msoFileTypeExcelWorkbooks
        '.Filename = File_Name & "*.xls"
        .LookIn = Search_Folder
        .SearchSubFolders = False
        If .Execute > 0 Then
            For iCount = 1 To .FoundFiles.Count
                'LBound(.FoundFiles) To UBound(.FoundFiles)
                ImportFileName = .FoundFiles(iCount)
                ImportThisExcel ImportFileName
            Next iCount
        Else
            MsgBox "No file found in " & Search_Folder, _
                   vbCritical + vbOKOnly, "Importing Excels"
        End If
    End With
    Exit Function
    [COLOR=blue]
BadImport:
    Select Case Err.Number 
        [/color][COLOR=green]' All the error numbers that may be raised
        ' by an import failure.[/color][COLOR=blue]
        Case 111, 222, 333, ...  
            MsgBox "Failed to Import File " & ImportFileName
            Resume Next
        Case Else
            [/color][COLOR=green]' Handle other Errors.[/color][COLOR=blue]
            MsgBox Err.Description
    End Select
    [/color]
End Function

Errors will "bubble up" from the "ImportThisExcel" routine to this active error handler.

 

[ch4meleon]

thanks i'll have a go at that now