Results 1 to 2 of 2
  1. #1
    3 Star Lounger MacroAlan's Avatar
    Join Date
    Feb 2003
    Location
    St Louis, Missouri, USA
    Posts
    250
    Thanks
    3
    Thanked 1 Time in 1 Post

    Exclamation Sending Outlook e-mail from Access 2010

    I have a cool database I created because I am the secretary of 7 stamp clubs in my area. Decided it would preferable to have one DB to handle the overlap.

    Couple things I need to do is to write emails to members based on which club. I want to be able to choose which email Account but Access is not cooperating.

    Code:
    Private Sub cmdCreateEmail_Click()
        Dim RS          As Recordset
        Dim dB          As Database
        Dim CT          As Recordset
        Dim strEmail    As String
        Dim strMsg      As String
        Dim EmailList   As String
        Dim objRecipient As Outlook.Recipient
        Dim oLook       As Outlook.Application
        Dim oMail       As Outlook.MailItem
        Dim oAccount    As Outlook.Account
        Dim sqlString   As String
        Dim MsgBody     As String
        Dim CountString As String
        Dim X           As Long
        Dim Z           As Long
       On Error GoTo cmdCreateEmail_Click_Error
        If Me.MsgSubject = Null Then
            MsgBox "Please type a Subject for this email and continue", vbInformation, "Subject ??"
            Exit Sub
        End If
        Set dB = CurrentDb()
        Set oLook = Outlook.Application
        EmailList = ""
        CountString = "SELECT COUNT (*) as RecsCount FROM NamesMaster AS NM LEFT JOIN  (LocalMembership AS LM LEFT JOIN tblEmailAddresses AS EmailA " _
            & " ON LM.MemberID = EmailA.MemberID) ON NM.ID = LM.MemberID  WHERE (((EmailA.Prefered)=True) AND ((NM.Deceased)=False) AND ((LM.ClubID)=" _
            & Me.ClubName.Value & ") AND ((LM.InUse)=1)); "
        Set CT = dB.OpenRecordset(CountString, dbOpenDynaset)
        Z = CT.Fields("RecsCount")      'Determine number of records
        If Z < 1 Then GoTo cmdCreateEmail_Click_Error
                Set oMail = oLook.CreateItem(olMailItem)
        'Recordset to get mail recipients
        sqlString = "SELECT  * FROM NamesMaster AS NM LEFT JOIN  (LocalMembership AS LM LEFT JOIN tblEmailAddresses AS EmailA ON LM.MemberID = EmailA.MemberID) ON NM.ID = LM.MemberID "
        sqlString = sqlString & " WHERE (((EmailA.Prefered)=True) AND ((NM.Deceased)=False) AND ((LM.ClubID)=" & Me.ClubName.Value & ") AND ((LM.InUse)=1)); "
        Set RS = dB.OpenRecordset(sqlString, dbOpenDynaset)
            RS.MoveFirst
            Do While Not RS.EOF
          '      Debug.Print RS.Fields("LastName") & Chr(32) & RS.Fields("EmailAddress")
            'do the mailing thing
            EmailList = EmailList & RS.Fields("EmailAddress") & ";"
      '+--------------------------------------------------------------------------------------------
                RS.MoveNext
            Loop
    With oMail
        MsgBody = "<p>" & Me.EmailMsg & "</p><p>------------</p><p>" & Me.ContactName.Value
        MsgBody = MsgBody & "<br />" & Me.ContactEmail.Value & "</p>"
        .BCC = EmailList
        .HTMLBody = MsgBody
        .Subject = Me.MsgSubject.Value
       ' .SendUsingAccount = OutlookNamespace.Accounts("alan@l.org") ' does not work
        .ReminderSet = True
        If Me.bPreview = 1 Then
            .display
        Else
            .Send
        End If
    End With
    If bPreview = False Then
    End If
     
       '+--------------------------------------------------------------------------------------------
       Set CT = dB.OpenRecordset("tblEmailMsg", dbOpenDynaset)
        With CT
            .AddNew                  'Write details to log
            EmailMsg = MsgBody
            Subject = Me.MsgSubject.Value
       '     ClubID = Me.ClubID.Value
            From = Me.ContactName.Value
            fromemail = Me.ContactEmail.Value
            .Update
        End With
        Set CT = Nothing
       Set RS = Nothing
       Set dB = Nothing
        Set oMail = Nothing
        Set oLook = Nothing
       On Error GoTo 0
       Exit Sub
    cmdCreateEmail_Click_Error:
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdCreateEmail_Click of VBA Document Form_frmWriteEmail"
    End Sub
    Found a lot of places on the web that numerate the POP3 accounts, all of mine are IMAP.
    Alan

  2. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    5,939
    Thanks
    0
    Thanked 94 Times in 90 Posts
    Unless I've overlooked something, you haven't declared or initialised an OutlookNamespace variable?
    Regards,
    Rory
    Microsoft MVP - Excel.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •