Error Handler Problem

[chizzy42]

Hi,
My aim is to import text files from a server and put them in an access database, the code I have works for this task, but occasionally there are file read and write errors due to the text files being accessed at the time they’re being written by a labview app. This results in a message box appearing and the code stopping updating, this has to run 24/7 why im im trying to make it error free. I’ve added an error handler to detect an error to prevent the hang up and to email me when this occurs. My issue is that when the error occurs and is flagged the program sends out an email every time the code runs , it’s on a timer so runs every few minutes.

Could someone check the code please and tell me how to have the email happen only once….im assuming that the error is somehow trapped in the code and that is why it is getting sent out every refresh.

(i) Is there a way to flush the error so when the code runs again , there are no errors trapped.

(ii) Ideally I’d like to see what DoCmd.TransferText block is causing the error( there could be around 40 DoCmd.TransferText blocks)..should I have an error handler around every DoCmd.TransferText block I have to identify where the error originates or is there another way to achieve this.

Any other feedback on the code would be appreciated to.

Thanks in advance

ian




Private Sub Form_Timer()

On Error GoTo Import_Err

Dim DateStringrockD As String
DoCmd.SetWarnings False
DateStringrockD = (Format(Day(Now()) + 1, "dd") & "D" & Format(Month(Now()) + 1, "dd") & Format(Now(), "yy"))


If Dir("T:\HOS UK07\Test data\siskin\siskinRF\" & DateStringsisN & ".txt") <> "" Then
DoCmd.TransferText acImportDelim, "FCS", "tblFCS", "T:\HOS UK07\Test data\siskin\siskinRF\" & DateStringsisN & ".txt"
End If

Dim DateStringsisD As String
DoCmd.SetWarnings False
DateStringsisD = (Format(Day(Now()) + 1, "dd") & "D" & Format(Month(Now()) + 1, "dd") & Format(Now(), "yy"))

If Dir("T:\HOS UK07\Test data\siskin\siskinRF\" & DateStringsisD & ".txt") <> "" Then
DoCmd.TransferText acImportDelim, "FCS", "tblFCS", "T:\HOS UK07\Test data\siskin\siskinRF\" & DateStringsisD & ".txt"
End If

'''''''''''''''ERROR HANDLING'''''''''''''''''''''''''''''

Import_Exit:
Exit Sub
Import_Err:

Dim appOutLook As Object
Dim MailOutLook As Object
'assign our object references
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(0)

With MailOutLook
'set the recipient list
.To = "emailaddress"
'set the subject
.Subject = "Trap Error"
'set the body text
.Body = "A Trap Error has occured"
'send the email
.Send
End With
'get rid of object references
Set appOutLook = Nothing
Set MailOutLook = Nothing

Resume Import_Exit

End Sub

[jonh]

i) err.clear or any 'on error' will clear it.
ii) Try not to repeat code. Do you really need more than one?

"Any other feedback on the code would be appreciated to."

Your error handler doesn't have an error handler.
How do you know what is causing the error? Get info about the error from the err object.

This is just a quick example. not tested.


Private Sub Form_Timer()
On Error Resume Next
Dim strErr As String, db As DAO.Database, rs As DAO.Recordset
Dim DateString As String, StrPath As String

Set db = CurrentDb
Set rs = db.OpenRecordset("select * from filepaths where filetype='import'")
Do Until rs.EOF
DateString = (Format(Day(Now()) + 1, "dd") & "D" & _
Format(Month(Now()) + 1, "dd") & Format(Now(), "yy"))
StrPath = Replace(rs("filepath").Value, "$DATE$", DateString)
strErr = strErr & Import(rs("SpecName").Value, rs("tbl").Value, StrPath)
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
SendMail strErr
End Sub

Private Function Import(SpecName As String, tbl As String, Path As String) As String
On Error Resume Next
DoCmd.SetWarnings False
DoCmd.TransferText acImportDelim, SpecName, tbl, Path
DoCmd.SetWarnings True
Select Case Err.Number
Case Is <> 0
Import = Path & vbCrLf & _
Err.Number & ": " & Err.Description & vbCrLf & vbCrLf
End Select
End Function

Private Sub SendMail(msgbody As String)
On Error Resume Next
If msgbody = "" Then Exit Sub
Dim appOutLook As Object, MailOutLook As Object
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(0)
With MailOutLook
.To = "emailaddress"
.Subject = "Trap Error"
.Body = msgbody
.Send
End With
Set appOutLook = Nothing
Set MailOutLook = Nothing
End Sub

[chizzy42]

hi jonh, thanks for the detailed code , i'll try and implement it tomorrow still getting to grips with vba so may take a while. i had tried using case statements also for error handling and getting the email to send the error code, my dilema really is that im going to be importing around 40+ text files and wanted to have an idea what text file was crashing the system when it occured..why i was asking if a could try a trap on each import....is there a way to have the error show the line of code that crashed the run?



On Error GoTo Err_Form_Timer
'''CODE HERE''''''

Exit_Form_Timer:
Exit Sub
Err_Form_Timer:
Select Case Err.Number
Case 3011

Dim appOutLook As Object
Dim MailOutLook As Object

'assign our object references
Set appOutLook = CreateObject("Outlook.Application")
' Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set MailOutLook = appOutLook.CreateItem(0)

With MailOutLook
'set the recipient list
.To = "emailaddress"

'set the subject
.Subject = "3011 Error"

'set the body text
.Body = "A 3011 Error has occured"

'send the email
.Send
End With
'get rid OF object references
Set appOutLook = Nothing
Set MailOutLook = Nothing
Resume Next
Case Else
Resume Exit_Form_Timer
End Select

[jonh]

I don't think so, no. You can output any information you like, however you like, so it's not really necessary.