Hallo,
Ik heb een formulier binnen access dat ik gebruik om mails te sturen. Hiervoor gebruik ik wat VBA welke voor 80% werkt.
Nu heb ik 3 textvakken genaamd update1 update2 update3 die enkel in de mail mogen geplakt worden als je ingevuld zijn. En dit werkt niet meteen.
Ook krijg ik steeds een error als ik de mail sluit zonder hem te sturen, terwijl ik hiervoor wel een workaround geschreven had...
Kan iemand een kijkje nemen?
Thx,DEWCAP
Ik heb een formulier binnen access dat ik gebruik om mails te sturen. Hiervoor gebruik ik wat VBA welke voor 80% werkt.
Nu heb ik 3 textvakken genaamd update1 update2 update3 die enkel in de mail mogen geplakt worden als je ingevuld zijn. En dit werkt niet meteen.
Ook krijg ik steeds een error als ik de mail sluit zonder hem te sturen, terwijl ik hiervoor wel een workaround geschreven had...
Kan iemand een kijkje nemen?
Thx,DEWCAP
Code:
Private Sub cmdEmail_Click()
Dim strRecipients As String
Dim rst As DAO.Recordset
Dim StrSQL As String
Dim strType As String
Dim strSubject As String
Dim strBody As String
Dim strSign As String
Const errUserCanceledAction As Long = 2501
On Error GoTo ErrorRoutine
strSign = Me.cboMember.Column(1)
strSubject = Me.txtSubject.Value
strBody = "Description" & Chr(13) & Me.txtBody.Value
If Not IsNull(Me.txtUpdate1.Value) Then
strBody = strBody & Chr(13) & Chr(13) & "Update 1:" & Chr(13) & Me.txtUpdate1.Value
End If
If Not IsNull(Me.txtUpdate2.Value) Then
strBody = strBody & Chr(13) & Chr(13) & "Update 2:" & Chr(13) & Me.txtUpdate2.Value
End If
If Not IsNull(Me.txtUpdate3.Value) Then
strBody = strBody & Chr(13) & Chr(13) & "Update 3:" & Chr(13) & Me.txtUpdate3.Value
End If
strType = Me.cboContacts.Column(0)
strBody = "Outage Email: " & Me.cboApplication.Column(1) & Chr(13) & "----------------------" & Chr(13) & strBody & Chr(13) & "----------------------" & Chr(13) & "Begin Date and Time: " & Me.txtBeginDate.Value & Chr(13) & "End Date and Time: " & Me.txtEndDate.Value & Chr(13) & Chr(13) & strSign
StrSQL = "SELECT dbo_Contacts.ContactID, dbo_Contacts.FirstName, dbo_Contacts.LastName, dbo_Contacts.CompanyName, dbo_Contacts.JobTitle, dbo_Contacts.Email FROM dbo_Contacts WHERE dbo_contacts.JobTitle = '" & strType & "';"
Set rst = CurrentDb.OpenRecordset(StrSQL)
Do While Not rst.EOF
strRecipients = strRecipients & ";" & rst![Email]
rst.MoveNext
Loop
strRecipients = Right(strRecipients, Len(strRecipients) - 1)
rst.Close
Set rst = Nothing
DoCmd.SendObject , , , strRecipients, , strSubject, strBody
RoutineExit:
Exit Sub
ErrorRoutine:
If Err.Number = errUserCanceledAction Then
Exit Sub
Else
MsgBox "Error number: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
End If
Resume RoutineExit
End Sub