Prompt for import error

[Purdue2479]

I am using the below code to import .csv files from a directory and it is working fine. But, I would like for it to prompt me when there is an import error (ex. field names don't match), allow me to skip the file, and then continue with the import. Any suggestions on how to do this would be appreciated. Thanks

I would also be interested in knowing how to show the time it took to import in the msgbox.

Public Sub subImport()
On Error GoTo Err_subImport

Dim stDocName As String
Dim fs As FileSearch
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim y As Integer
Dim ShortFn As String
'Dim specname As String

'specname = "Import Specs"
DoCmd.SetWarnings False
sql = "DELETE FROM tbl_temp_Import_2006"

DoCmd.RunSQL sql 'Empty Temp Table


DoCmd.SetWarnings False
oktogo = False
ifn = "C:\Projects"
Set fs = Application.FileSearch
With fs
.LookIn = ifn

.FileName = "*.csv"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then

For i = 1 To .FoundFiles.Count

ShortFn = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
DoCmd.TransferText acImportDelim, , "tbl_temp_Import_2006", .FoundFiles(i), True
'subArchive .FoundFiles(i)
y = y + 1


Next i
Else
MsgBox "Please ensure that the source file is present and try again" & vbCr _
& "Required file location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"


Exit Sub
End If
End With




MsgBox "Import complete. " & y & " files Imported", vbOKOnly + vbInformation, "Import Complete"

Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True

Exit Sub

Err_subImport:
MsgBox Err.Description
Resume Exit_subImport

End Sub

 

[tehNellie]

if you handle the import error (dont know the number off the top of my head) in your errorhandling with something along the lines of:

if err.number = <whatever the number is>
  intresponse = msgbox ("Import Failed on " & strfilename & " , click 'ok' to ignore file or 'Cancel' to quit", vbokcancel)
  If intresponse = 2 then
    resume next
  else
    exit sub
  end if
end if

Then I think that should do the trick

In terms of how long something takes:

dim sngStartime as single
dim sngEndtime as single

sngstarttime = timer()

[i]block of code[/i]

sngendtime = timer()

msgbox "Time taken = " & sngendtime - sngstarttime & " seconds."

 

[Purdue2479]

That worked. But, how do I get the file count to exclude the file that was not imported? If I click 'ok' to ignore it, the 'y' variable still includes the ignored file. Also, is there a way to show the elapsed time as hours, mins, and secs ( ex. 3 hrs 14 mins 3 secs)?

 

[tehNellie]

there is a function here (linking rather than pasting it as my own) that converts seconds to hours minutes etc.

hows about you rename y to something like intTotalfiles and declare a new variable intFailedFiles. everytime a file fails increment intFailedfiles by one. Subtract total files by failed files and you'll know how many you processed.

 

[Purdue2479]

Could you show me how I would implement the time function in my code? Thanks

 

[Purdue2479]

I figured out how to implement the timestring code and to exclude the failed files from the import count. I would like to know how to capture a list of the files that have failed and show those in a report or table somehow. Is there a way to do this?

Private Sub subImport()
On Error GoTo Err_subImport

Dim stDocName As String
Dim fs As FileSearch
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim intTotalFiles As Integer
Dim intFailedFiles As Integer
Dim ShortFn As String
Dim Start_Time As Date, End_Time As Date
Dim intresponse As String
Dim interval As Long
Dim Time_Obj As String

'specname = "Import Specs"

DoCmd.SetWarnings False
'sql = "DELETE FROM tbl_temp_Import_2006"
'sql = "DELETE FROM tbl_temp_Import"

Start_Time = Time

'DoCmd.RunSQL sql 'Empty Temp Table

oktogo = False
ifn = "U:\My Documents\CSV Files"
Set fs = Application.FileSearch

With fs
.LookIn = ifn
.FileName = "*.csv"
    If .Execute(SortBy:=msoSortByFileName, _
        SortOrder:=msoSortOrderAscending) > 0 Then

        For i = 1 To .FoundFiles.Count

        ShortFn = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
        DoCmd.TransferText acImportDelim, , "tbl_temp_Import_test", .FoundFiles(i), True
        'subArchive .FoundFiles(i)
        intTotalFiles = intTotalFiles + 1

        Next i

    Else
      MsgBox "Please ensure that the source file is present and try again" & vbCr _
      & "Required file location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"

        Exit Sub
    End If
End With

End_Time = Time

interval = DateDiff("s", Start_Time, End_Time)

Time_Obj = TimeString(interval, True)

MsgBox "Import complete. " & intTotalFiles - intFailedFiles & " files Imported. Import Time:" & (Time_Obj) & " .", vbOKOnly + vbInformation, "Import Complete"

Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True

Exit Sub

Err_subImport:
If Err.number = 2391 Then
  intresponse = MsgBox("Import Failed on " & ShortFn & " , click Ok to ignore file or Cancel to quit import", vbOKCancel)
  If intresponse = 1 Then
  intFailedFiles = intFailedFiles + 1
    Resume Next
  Else
    Exit Sub
  End If
End If

End Sub

 

[Purdue2479]

I figured out how to copy the failed file names into a table. Thanks for the help.