Call Procedure not working

PatAccess

Registered User.
Local time
Today, 18:32
Joined
May 24, 2017
Messages
284
Good day all,


I have a cmd bttn with the following code:

Private Sub cmdUpCert_Click()
Dim objCert As Object
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant

Set objCert = Application.FileDialog(3)
objCert.allowMultiSelect = True
If objCert.Show Then
For Each varItem In objCert.SelectedItems
strFile = Dir(varItem)

strFolder = Left(varItem, Len(varItem) - Len(strFile))
MsgBox "Folder" & strFolder & vbCrLf & "File: " & strFile
UpCert = strFolder + strFile

Next
End If
Call CertificateEmail
Set objCert = Nothing
End Sub

When I click the bttn the dialog box open and I can grab my file but the CertificateEmail procedure does not work. The email does not open. What am I missing please?

Here is the CertificateEmail Procedure Code:
Private Sub CertificateEmail()
On Error GoTo Exit_Sub:
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem

Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Qry_Cert")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
If IsNull(rs!Email) Then
rs.MoveNext
Else
If oOutlook Is Nothing Then
Set oOutlook = New Outlook.Application
End If
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
.To = "arlette.watson@rmf.com"
.Subject = "A new certificate has been entered in the database"
.Body = "Check Tbl_EngineerLic for" & vbCr & _
"ID: " & rs!ID & vbCr & _
"License Number: " & rs!LicNum & vbCr & _
"Employee: " & rs!Emp & vbCr & vbCr & _
"Thank you"
.Display
'.Send
rs.Edit
'rs!EmailSent = Date
'rs.OpenNotify = Date
rs.Update
End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
rs.MoveNext
End If
Loop
Else
'Do Nothing
End If
rs.Close
Exit_Sub:
Exit Sub
End Sub

Thank you for the help
 
Eliminate the test of record count and the move first right after. I'd open the recordset on records where the email address wasn't null and eliminate that test too.
 
The email dialog is still not open
I've changed my Query to show only where Email is not Null so I did not have to do that test but the email dialog is still not opening.

Here is what I have for the email Sub now
Private Sub CertificateEmail()
On Error GoTo Exit_Sub:
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem

Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Qry_Cert")

Do Until rs.EOF
Set oOutlook = New Outlook.Application
Set oEmailItem = oOutlook.CreateItem(olMailItem)
With oEmailItem
.To = "email@rmf.com"
.Subject = "A new certificate has been entered in the database"
.Body = "Check Tbl_EngineerLic for" & vbCr & _
"ID: " & rs!ID & vbCr & _
"License Number: " & rs!LicNum & vbCr & _
"Employee: " & rs!Emp & vbCr & vbCr & _
"Thank you"
.Display
'.Send
rs.Edit
'rs!EmailSent = Date
'rs.OpenNotify = Date
rs.Update
End With
Set oEmailItem = Nothing
Set oOutlook = Nothing
rs.MoveNext
Loop

rs.Close
Exit_Sub:
Exit Sub

The one to upload my document is unchanged

Any idea?

Thank you
 
Are you sure the query returns records? Have you set a breakpoint and stepped through it?
 
Yes I check and did it again. That query returns records. When I place this same code into a click event button, it works
I just want to call that procedure so when a document is uploaded it will send an email.

I just stepped through it again and once I'm at the call CertificateEmail it jumps the procedure but it says. = Nothing.
I don't get it
 
Can you attach the db here?
 
Where is

Code:
Private Sub CertificateEmail()


Try removing Private
 
Comment out the error handling line.
Code:
[B][COLOR=Red]'[/COLOR][/B]On Error GoTo Exit_Sub:
 
OK JHB Now I've gotten somewhere. Once I commented out that like it gave me error code Item was not found in this collection because one of my rs!Field was misspelled.
I am so happy right now. Thank you so much guys

It's works!!
 

Users who are viewing this thread

Back
Top Bottom