Creating Outlook mail item from specified outlook account (1 Viewer)

reglarh

Registered User.
Local time
Today, 09:03
Joined
Feb 10, 2014
Messages
118
I have written VBA code which sends out emails with customised attachments to all addressees in an Access 2010 table. The person sending this emails has multiple Outlook accounts. I have tried using the .sendusingaccount feature but I keep getting errors. Can anyone help?

Code:
Dim dbName As Database
    Dim rst As Recordset
    Dim zWhere As String
    Dim zMsgBody As String
    Dim zEmail As String
    Dim zFirstname As String
    Dim zSubject As String
    Dim zMessage As String
    Dim zDocname As String
    Dim olApp As outlook.Application
    Dim olMail As outlook.MailItem
    Dim objOutlookAttach As outlook.Attachment
    Dim dbs As DAO.Database
    Dim rsSQL As DAO.Recordset
    Dim strSQL As String
    Dim eMailSubject As String
    Dim eMailContent As String
    Dim Attachment1 As String
    Dim Attachment2 As String
    Dim Attachment3 As String
   
    eMailSubject = DLookup("[eMailSubject]", "[FileLocations]", "[RecordNumber] = 1")
    eMailContent = DLookup("[eMailContent]", "[FileLocations]", "[RecordNumber] = 1")
    Attachment1 = DLookup("[Attachment1]", "[FileLocations]", "[RecordNumber] = 1")
    Attachment2 = DLookup("[Attachment2]", "[FileLocations]", "[RecordNumber] = 1")
    Attachment3 = DLookup("[Attachment3]", "[FileLocations]", "[RecordNumber] = 1")
    
    Set olApp = New outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)
    Set dbName = CurrentDb()
    Set rst = dbName.OpenRecordset("GroupLeaderEmail")
    zDocname = "GroupMembership"
    rst.MoveFirst
  
Do While Not rst.EOF

If (Me.Frame7 = 1 And rst!AlphaGroup Like "[A-D]") Or (Me.Frame7 = 2 And rst!AlphaGroup Like "[E-K]") Or (Me.Frame7 = 3 And rst!AlphaGroup Like "[L-R]") Or (Me.Frame7 = 4 And rst!AlphaGroup Like "[S-Z]") Or Me.Frame7 = 5 Then
    zWhere = "[GroupCode] = " & Chr(34) & (rst![GroupCode]) & Chr(34)
    zFirstname = rst![FirstName]
    DoCmd.OpenReport zDocname, acPreview, , zWhere
    DoCmd.OutputTo acReport, , acFormatRTF, Attachment3, False
    Set olMail = olApp.CreateItem(olMailItem)

    With olMail
        .BodyFormat = olFormatHTML
        .To = rst![PrivateEMail]
        .CC = ""
        .Subject = eMailSubject
        .Body = "Dear " & zFirstname & vbNewLine & vbNewLine & eMailContent
        olMail.Attachments.Add Attachment1
        olMail.Attachments.Add Attachment2
        olMail.Attachments.Add Attachment3
        .Save
        .Send
    End With

    Kill ("C:\Users\Peter\Documents\GroupMembership.rtf")
    DoCmd.Close acReport, zDocname
         
End If
    
    rst.MoveNext        '*** Move to Next Record ***
        
Loop
    
    Set rst = Nothing     '*** Close RecordSet ***
    Set olMail = Nothing
    Set objOutlookAttach = Nothing
    Set olApp = Nothing
    Set rstAttachments = Nothing
    Set db = Nothing
    
End Sub
 

reglarh

Registered User.
Local time
Today, 09:03
Joined
Feb 10, 2014
Messages
118
This makes me even more confused since I have now got it working but not in the way these references explain - in fact my solution contradicts these references. I have cut down my code to the bare essentials to test and I am testing on my own system where I have two Outlook 2013 accounts. the code is:
Code:
Private Sub Command5_Click()
Dim dbName As Database
    Dim rst As Recordset
    Dim zWhere As String
    Dim zMsgBody As String
    Dim zEmail As String
    Dim zFirstname As String
    Dim zSubject As String
    Dim zMessage As String
    Dim zDocname As String
    Dim oApp As Outlook.Application

    Dim objOutlookAttach As Outlook.Attachment
    Dim dbs As DAO.Database
    Dim rsSQL As DAO.Recordset
    Dim strSQL As String
    Dim oaccount As Outlook.Account
   
 For Each oaccount In Outlook.Session.Accounts
 ' MsgBox (oaccount.CurrentUser)
 ' MsgBox (oaccount.UserName)
 ' MsgBox (oaccount.SmtpAddress)
 MsgBox (oaccount)
If oaccount.DisplayName = "Paula" Then
    Dim oMail As Outlook.MailItem
    Set oMail = Outlook.CreateItem(olMailItem)
    oMail.BodyFormat = olFormatHTML
    oMail.To = "harold.reglar@btinternet.com"
    oMail.CC = ""
    oMail.Subject = "Test"
    oMail.Body = "Test only "
    [COLOR="Red"]' oMail.SenderEmailAddress = "paula.reglar@btinternet.com"
[/COLOR]   [COLOR="SeaGreen"] oMail.SendUsingAccount = oaccount
[/COLOR]   [COLOR="red"] ' Set oMail.SendUsingAccount = "Paula"
[/COLOR]    oMail.Save
    oMail.Display
    oMail.Send
 End If
Next
       
End Sub

The email account to use will be held in a table, but for the moment is hard coded.

Using the Green line of code works, the Red lines do not work. If I prefix the Green line with SET it does not work!

The error if I try to use the specific use of 'Paula' is Type Mismatch and if I try to use the 'Paula.reglar@btinternet.com' line the message 'Object Variable or with block not set' is produced.

So I am happy I have code that works, unhappy that I do not understand what is going on!
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 17:03
Joined
Jul 9, 2003
Messages
16,280
I don't see you using this line of code from the second link:-

Set ol = olApp.Parent

I don't understand what it t does?
 

reglarh

Registered User.
Local time
Today, 09:03
Joined
Feb 10, 2014
Messages
118
I didn't understand either and since my code now works I didn't spend too much time ploughing through it.

As an ex-COBOL programmer from the 1960 I found some of the concepts difficult and found a lack of easy reference material to learn from. COBOL, FORTRAN, BASIC all had a limited set of verbs with which to manipulate data. VBA seems unlimited in its scope and has numerous ways of achieving a capability - hence the various apparently conflicting approaches to resolving my problems.

Hey Ho.......
 

reglarh

Registered User.
Local time
Today, 09:03
Joined
Feb 10, 2014
Messages
118
Ho ho ho is certainly more seasonal but it implies some jollity.

Hey ho is more resigned, along the lines of 'will I ever really understand what its all about'!
 

Users who are viewing this thread

Top Bottom