Can anyone help with this code.

thetambarineman · Mar 13, 2000

This code was kindly generated by Dougp, the thing is i'm having a little trouble getting it into a sub: - can anyone help me out as i'm hoping to push this app out the door as soon as poss!! Thanks for your time! 

 

Module code: 

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 

 

frm level code: 

Private Sub Command1_Click() 

On Error GoTo Err_Command1_Click 

 

' Raise the exception 

s = 3 / 0 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Exit_Command1_Click: '<<< Put all this code at the bottom right above the END SUB 

Exit Sub 

 

Err_Command1_Click: 

Select Case Err.Number 

Case 3021 

' No current record 

 

Case Else 

reply = MsgBox("An error has occured, do you wish to send a report to the developers?", vbInformation + vbYesNo, "Error encountered: Send report?") 

If reply = vbYes Then 

 

 

'End Select 

 

Dim stext As String 

Dim sAddedtext As String 

 

stext = "mailto:" & "<A HREF="mailto

aul.mclornan@btinternet.com">paul.mclornan@btinternet.com</A>" 

 

sAddedtext = sAddedtext & "&Subject=" & "Autospare Code error " & Err.Number & " " & Err.Description 

sAddedtext = sAddedtext & "&Body=" & "The following error has been recorded!" & " " & Err.Description & " " & Err.Number & " " & Err.Source 

 

If Len(sAddedtext) <> 0 Then 

Mid$(sAddedtext, 1, 1) = "?" 

 

stext = stext & sAddedtext 

 

' launch default e-mail program 

If Len(stext) Then 

Call ShellExecute(Me.hwnd, "open", stext, vbNullString, vbNullString, SW_SHOWNORMAL) 

End If 

 

End If 

Else 

End If 

 

End Select 

 

End Sub 

---------- 

the thing is that i want it to be called instead of having to lump this code in every time that i want to trap errors!! 

 

Thanks in advance: 

Paul

DougP · Mar 13, 2000

So make a Function out of it 
And Pass the parameters 
Similar to this: 
 
Public Function E-mail(MailTo,Subject,Body, ....) 
 
 
Put the above code in here 
 
Including the Error traps 
 
End Function 
 DougP <a href=mailto: dposton@universal1.com> dposton@universal1.com</a> <a href= > </a>

DougP · Mar 13, 2000

Here it is 
 
I have a command button that raises and error and then calls a function 
The function Pops up a Error box and then e-mails the error 
 
---------------------------- This is the Error handler that you call my Function with 
Private Sub Command1_Click() 
On Error GoTo Err_Command1_Click 
 
' Raise the exception 
s = 3 / 0 
 
Exit_Command1_Click: 
Exit Sub 
 
Err_Command1_Click: 
'Call the Error handler /E-mailer 
ErrorTrapEmail Me.hwnd, "<A HREF="mailto:myemail@myweb.com">myemail@myweb.com</A>", "Autospare Code error " & Err.Number & " " & Err.Description, "The following error has been recorded!" & " " & Err.Description & " " & Err.Number & " " & Err.Source 
Resume Exit_Command1_Click 
 
End Sub 
 
------------------------------------------- 
this is the modified Error handler 'Put this following in Module so it can be called from anywhere in your project 
If you create a separate Module called "ErrorEmailer.bas" then you can add it to any future project. 
-------------------------------------------- 
Public Sub ErrorTrapEmail(FormHandle, MailTo, Subject, Body) 
 
MsgBox "Error # " & Err.Number & " " & Err.Description, vbInformation, "In sub Command1_Click" 
 
Dim stext As String 
Dim sAddedtext As String 
 
stext = "mailto:" & MailTo 
 
sAddedtext = sAddedtext & "&Subject=" & Subject '"Error From VB Program " & Err.Number & " " & Err.Description 
sAddedtext = sAddedtext & "&Body=" & Body '"Put your Body Text here if needed" 
 
If Len(sAddedtext) <> 0 Then 
Mid$(sAddedtext, 1, 1) = "?" 
End If 
 
stext = stext & sAddedtext 
 
' launch default e-mail program 
If Len(stext) Then 
Call ShellExecute(FormHandle, "open", stext, vbNullString, vbNullString, SW_SHOWNORMAL) 
End If 
End Sub 
 
 DougP <a href=mailto: dposton@universal1.com> dposton@universal1.com</a> <a href= > </a>

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Can anyone help with this code.

thetambarineman

Technical User

DougP

MIS

DougP

MIS

Similar threads

Part and Inventory Search

Sponsor