DoCmd.SendObject

Status
Niet open voor verdere reacties.

DEWCAP

Gebruiker
Lid geworden
14 dec 2006
Berichten
79
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

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
 
Status
Niet open voor verdere reacties.

Nieuwste berichten

Terug
Bovenaan Onderaan