fuentro
05-26-2015, 01:39 AM
Hello,
I'm trying to fix the code someone else wrote in an application made in Access.
Please help as I cannot identify where the problem is I'm getting a "Invalid use of Null" when trying to send an email via VBA through an Access form
Private Sub cmdSendEmailNewTemplate_Click()
Dim db As Database
Dim appl As Object 'Outlook.Application
Dim mailItm As Object 'MailItem
Dim myAttachments As Object
Dim Salutation, firstnm, lastnm, Title As String
Dim emailBody As Variant
Dim emailSubject As Variant
Dim cntctid As Integer
Dim InteractionDateTime As Date
Dim CreatedBy, InteractionType, Note As String
Dim CampaignID, CompanyID, ContactID, ToDoID, EmailTemplateID As Long
Dim rscmpny As Recordset
Dim rscntct As Recordset
Dim i As Integer
Set appl = CreateObject("Outlook.Application")
Set mailItm = appl.CreateItem(0) 'olMailItem
On Error GoTo Err
If IsNull(txtEmailSub) Then
Exit Sub
End If
If Trim(txtEmailSub) = "" Then
Exit Sub
End If
If IsNull(txtEmailBody) Then
Exit Sub
End If
If Trim(txtEmailBody) = "" Then
Exit Sub
End If
If lstSelectedContacts.ListCount = 0 Then
MsgBox "No contacts selected, please select the contacts to email", vbCritical
Exit Sub
End If
emailBody = txtEmailBody.Value
emailSubject = txtEmailSub.Value
Set db = CurrentDb
If lstSelectedContacts.ListCount > 0 Then
For i = 0 To lstSelectedContacts.ListCount - 1
firstnm = ""
emailBody = txtEmailBody.Value
cntctid = lstSelectedContacts.Column(0, i)
CompanyID = DFirst("[CompanyID]", "Contacts", "ID=" & cntctid & "")
mailItm.To = DFirst("[Email]", "Contacts", "ID=" & cntctid & "")
emailSubject = txtEmailSub.Value
firstnm = DFirst("[First Name]", "Contacts", "ID=" & cntctid & "")
Salutation = DFirst("[Salutation]", "Contacts", "ID=" & cntctid & "")
lastnm = DFirst("[Last Name]", "Contacts", "ID=" & cntctid & "")
Title = DFirst("[Title]", "Contacts", "ID=" & cntctid & "")
'emailBody = "Mr. " & firstnm & vbCrLf & bdy & vbCrLf
emailBody = Replace(emailBody, "<Contact.Salutation>", IIf(IsNull(Salutation), "", Salutation))
emailBody = Replace(emailBody, "<Contact.FirstName>", IIf(IsNull(firstnm), "", firstnm))
emailBody = Replace(emailBody, "<Contact.LastName>", IIf(IsNull(lastnm), "", lastnm))
emailBody = Replace(emailBody, "<Contact.Title>", IIf(IsNull(Title), "", Title))
mailItm.Body = emailBody
If IsNull(txtEmailAttach.Value) = False Then
If Trim(txtEmailAttach.Value) <> "" Then
mailItm.Attachments.Add (txtEmailAttach)
End If
End If
mailItm.Send
Set mailItm = Nothing
InteractionDateTime = DateTime.Now
CreatedBy = loggedInUserString(0) ' "testusr1" ' loggedInUserString(0) 'TODO
InteractionType = "Email"
Title = emailSubject
Note = emailBody
db.Execute " INSERT INTO Interaction ( InteractionDateTime, Createdby, Type, Title, [Note], CompanyID, ContactID) " _
& " VALUES ( '" & InteractionDateTime & "' , '" & CreatedBy & "' , '" & InteractionType & "' , '" & Title & "' , '" & Note & "' , " & CompanyID & " , " & cntctid & " ) ", dbSeeChanges
firstnm = ""
emailBody = txtEmailBody
cntctid = 0
Next i
lstSelectedContacts.RowSource = ""
lstSelectedContacts.Requery
db.Execute " Update Contacts Set SelectYesNo = False WHERE SelectYesNo = True ", dbSeeChanges
Form_frmContactsDatasheet.Requery
Form_frmMain.Requery
End If
Set db = Nothing
Exit Sub
Err:
MsgBox Err.Description
Err.Clear
Set db = Nothing
End Sub
I'm trying to fix the code someone else wrote in an application made in Access.
Please help as I cannot identify where the problem is I'm getting a "Invalid use of Null" when trying to send an email via VBA through an Access form
Private Sub cmdSendEmailNewTemplate_Click()
Dim db As Database
Dim appl As Object 'Outlook.Application
Dim mailItm As Object 'MailItem
Dim myAttachments As Object
Dim Salutation, firstnm, lastnm, Title As String
Dim emailBody As Variant
Dim emailSubject As Variant
Dim cntctid As Integer
Dim InteractionDateTime As Date
Dim CreatedBy, InteractionType, Note As String
Dim CampaignID, CompanyID, ContactID, ToDoID, EmailTemplateID As Long
Dim rscmpny As Recordset
Dim rscntct As Recordset
Dim i As Integer
Set appl = CreateObject("Outlook.Application")
Set mailItm = appl.CreateItem(0) 'olMailItem
On Error GoTo Err
If IsNull(txtEmailSub) Then
Exit Sub
End If
If Trim(txtEmailSub) = "" Then
Exit Sub
End If
If IsNull(txtEmailBody) Then
Exit Sub
End If
If Trim(txtEmailBody) = "" Then
Exit Sub
End If
If lstSelectedContacts.ListCount = 0 Then
MsgBox "No contacts selected, please select the contacts to email", vbCritical
Exit Sub
End If
emailBody = txtEmailBody.Value
emailSubject = txtEmailSub.Value
Set db = CurrentDb
If lstSelectedContacts.ListCount > 0 Then
For i = 0 To lstSelectedContacts.ListCount - 1
firstnm = ""
emailBody = txtEmailBody.Value
cntctid = lstSelectedContacts.Column(0, i)
CompanyID = DFirst("[CompanyID]", "Contacts", "ID=" & cntctid & "")
mailItm.To = DFirst("[Email]", "Contacts", "ID=" & cntctid & "")
emailSubject = txtEmailSub.Value
firstnm = DFirst("[First Name]", "Contacts", "ID=" & cntctid & "")
Salutation = DFirst("[Salutation]", "Contacts", "ID=" & cntctid & "")
lastnm = DFirst("[Last Name]", "Contacts", "ID=" & cntctid & "")
Title = DFirst("[Title]", "Contacts", "ID=" & cntctid & "")
'emailBody = "Mr. " & firstnm & vbCrLf & bdy & vbCrLf
emailBody = Replace(emailBody, "<Contact.Salutation>", IIf(IsNull(Salutation), "", Salutation))
emailBody = Replace(emailBody, "<Contact.FirstName>", IIf(IsNull(firstnm), "", firstnm))
emailBody = Replace(emailBody, "<Contact.LastName>", IIf(IsNull(lastnm), "", lastnm))
emailBody = Replace(emailBody, "<Contact.Title>", IIf(IsNull(Title), "", Title))
mailItm.Body = emailBody
If IsNull(txtEmailAttach.Value) = False Then
If Trim(txtEmailAttach.Value) <> "" Then
mailItm.Attachments.Add (txtEmailAttach)
End If
End If
mailItm.Send
Set mailItm = Nothing
InteractionDateTime = DateTime.Now
CreatedBy = loggedInUserString(0) ' "testusr1" ' loggedInUserString(0) 'TODO
InteractionType = "Email"
Title = emailSubject
Note = emailBody
db.Execute " INSERT INTO Interaction ( InteractionDateTime, Createdby, Type, Title, [Note], CompanyID, ContactID) " _
& " VALUES ( '" & InteractionDateTime & "' , '" & CreatedBy & "' , '" & InteractionType & "' , '" & Title & "' , '" & Note & "' , " & CompanyID & " , " & cntctid & " ) ", dbSeeChanges
firstnm = ""
emailBody = txtEmailBody
cntctid = 0
Next i
lstSelectedContacts.RowSource = ""
lstSelectedContacts.Requery
db.Execute " Update Contacts Set SelectYesNo = False WHERE SelectYesNo = True ", dbSeeChanges
Form_frmContactsDatasheet.Requery
Form_frmMain.Requery
End If
Set db = Nothing
Exit Sub
Err:
MsgBox Err.Description
Err.Clear
Set db = Nothing
End Sub