VBA debug I can't do

[Smudger Smith]

Hello,

I can't figure out what is wrong with this:


Public Function SendEmail()

PROC_DECLARATIONS:
Dim olApp As Outlook.Application
Dim olnamespace As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim dbs As Database
Dim rstEmailDets As Recordset
Dim strSender As String
Dim strRecipient As String
Dim strEmail As String

PROC_START:
On Error GoTo PROC_ERROR

PROC_MAIN:
DoCmd.SetWarnings False

Set dbs = CurrentDb

'Put on hourglass
DoCmd.Hourglass True

'Collect the email details in a recordset to use in the email loop below
Set rstEmailDets = dbs.OpenRecordset("SELECT * FROM TBL_0299_ERROR_FILE;")

With rstEmailDets
.MoveFirst
Do While Not rstEmailDets.EOF

'Set parameters for email: recipient name, recipient email
strRecipient = Nz(rstEmailDets("NAME"), "")
strEmail = Nz(rstEmailDets("E_MAIL1"), "")
strBody = Nz(rstEmailDets("Suppress_Reason"), "")
strSite = Nz(rstEmailDets("Restoid"), "")

'Create a new instance of an Outlook Application object
Set olApp = New Outlook.Application
Set olnamespace = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)

With olMail

'Email Details
.To = strEmail
.Subject = "MTI Message for site " & strSite
.Body = "An error has occured for: " & strName & "," & vbCrLf & vbCrLf & _
"The error message created was: " & strBody & vbCrLf & " "
.Importance = olImportanceNormal
.Send

End With
.MoveNext
Loop

End With

' MsgBox "All Emails have now been sent, Thank you for your patience"

PROC_EXIT:
' Perform cleanup code here, set recordsets to nothing, etc.
On Error Resume Next
DoCmd.RunCommand acCmdWindowHide '(hides the database window)
Set olApp = Nothing
Set olnamespace = Nothing
Set olMail = Nothing
Set dbs = Nothing
Set rstEmailDets = Nothing
DoCmd.Hourglass False
Exit Function

PROC_ERROR:
If Err = -2147467259 Then
MsgBox "You have exceeded the storage limit on your mail box. Please delete some items before clicking OK", vbOKOnly
Resume
End If

If Err = 2501 Then
MsgBox "You have attempted to cancel the output of the emails." & vbCrLf & _
"This will cause major problems." & vbCrLf & _
"Please be Patient"
Resume
End If

End Function



can anyone please help

 

[ByteMyzer]

Is it giving you an error? If so, what is the error message you are getting, and what is the highlighted line of code when you select the Debug option?

 

[Smudger Smith]

Well, that is the strange thing - There is no error message and the debug goes through like the perverbal dose of salts. It may make more sence to you to show the table:

SUPRESS_REASON
NAME
RESTOID
DATES
E_MAIL1
E_MAIL2

All of the columns are populated

Thanks

 

[boblarson]

If no error is generated then how do you know it isn't doing what it is supposed to? What I would do is set a breakpoint and check things at every point to see what is occurring.

 

[ByteMyzer]

Your FIRST problem lies in this section of code:

PROC_ERROR:
If Err = -2147467259 Then
MsgBox "You have exceeded the storage limit on your mail box. Please delete some items before clicking OK", vbOKOnly
Resume
End If

If Err = 2501 Then
MsgBox "You have attempted to cancel the output of the emails." & vbCrLf & _
"This will cause major problems." & vbCrLf & _
"Please be Patient"
Resume
End If

Your error trap code only accounts for two error codes. If you encounter any other error, the error trap will not tell you.

I would suggest the following modification:

PROC_ERROR:
If Err = -2147467259 Then
    MsgBox "You have exceeded the storage limit on your mail box. " _
        & "Please delete some items before clicking OK", vbOKOnly
    Resume
ElseIf Err = 2501 Then
    MsgBox "You have attempted to cancel the output of the emails." & vbCrLf & _
        "This will cause major problems." & vbCrLf & _
        "Please be Patient"
    Resume
Else
    MsgBox "Run-time error '" & Err.Number & "':" & vbNewLine _
        & vbNewLine & Err.Description, vbExclamation
End If

However, for debugging purposes until you have resolved the problem with your code, turn off error-trapping by commenting out the following line:

On Error GoTo PROC_ERROR

 

[Smudger Smith]

I know it is not working as there are no e-mails being generated.

I think it is to do with what is going into the mail rather than any of the "Fluffy" stuff towards the end

 

[Smudger Smith]

Thanks Bytemyzer - Still no mails going out though

 

[ByteMyzer]

Did you comment out the error trap line, as I suggested?

' On Error GoTo PROC_ERROR

 

[Smudger Smith]

Ah! - I see now where you are coming from

strBody = Nz(rstEmailDets("Suppress_Reason"), "") is where the debug kicks in but what is wrong with it? I am quite new to vb so the logic seems ok but the syntax may not be

 

[boblarson]

strBody = Nz(rstEmailDets.Fields("Suppress_Reason"), "")

 

[ByteMyzer]

boblarson,

Actually, both:
strBody = Nz(rstEmailDets("Suppress_Reason"), "")
...and
strBody = Nz(rstEmailDets.Fields("Suppress_Reason"), "")

...are syntactically acceptable in VBA, as long as the specified field name exists in the referenced recordset.


Smudger Smith,

What is the specific error message you are receiving? (Error Number, Description, etc.)

 

[Smudger Smith]

Guys, Thanks for all of your help on this:

Public Function SendEmailToError()

PROC_DECLARATIONS:
Dim olApp As Outlook.Application
Dim olnamespace As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim dbs As Database
Dim rstEmailDets As Recordset
Dim strSender As String
Dim strRecipient As String
Dim strEmail As String

PROC_START:
On Error GoTo PROC_ERROR

PROC_MAIN:
DoCmd.SetWarnings False

Set dbs = CurrentDb

'Put on hourglass
DoCmd.Hourglass True

'Collect the email details in a recordset to use in the email loop below
Set rstEmailDets = dbs.OpenRecordset("SELECT * FROM TBL_0299_ERROR_FILE;")

With rstEmailDets
.MoveFirst
Do While Not rstEmailDets.EOF

'Set parameters for email: recipient name, recipient email
strRecipient = Nz(rstEmailDets("NAME"), "")
strEmail = Nz(rstEmailDets("E_MAIL1"), "")
strBody = Nz(rstEmailDets("SUPRESS_REASON"), "")
strSite = Nz(rstEmailDets("RESTOID"), "")

'Create a new instance of an Outlook Application object
Set olApp = New Outlook.Application
Set olnamespace = olApp.GetNamespace("MAPI")
Set olMail = olApp.CreateItem(olMailItem)

With olMail

'Email Details
.To = strEmail
.Subject = "MTI message for site " & strSite
.Body = "An error has been detected in association with " & strRecipient _
& ". The cause of the error is: " & strBody
.Importance = olImportanceNormal
.Send

End With
.MoveNext
Loop

End With

MsgBox "All Emails have now been sent, Thank you for your patience"

PROC_EXIT:
' Perform cleanup code here, set recordsets to nothing, etc.
On Error Resume Next
DoCmd.RunCommand acCmdWindowHide '(hides the database window)
Set olApp = Nothing
Set olnamespace = Nothing
Set olMail = Nothing
Set dbs = Nothing
Set rstEmailDets = Nothing
DoCmd.Hourglass False
Exit Function

PROC_ERROR:
If Err = -2147467259 Then
MsgBox "You have exceeded the storage limit on your mail box. Please delete some items before clicking OK", vbOKOnly
Resume
End If

If Err = 2501 Then
MsgBox "You have attempted to cancel the output of the emails." & vbCrLf & _
"This will cause major problems." & vbCrLf & _
"Please be Patient"
Resume
End If

End Function



seems to have worked.

Once again - Thanks for your replies