Solved Send email from ms access vbs from another email address? (1 Viewer)

Number11

Member
Local time
Today, 07:44
Joined
Jan 29, 2020
Messages
476
Is it possible to have the code changed to send the emails from a different outlook email address. this is my code..

I get this to work by creating a second profile in outlook and select that and it send correct but looking for a way now to have the code do this so the user doent need to do this


Code:
 Dim MyDB As Database
  Dim MyRS As Recordset
  Dim MyForm As Form
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim TheAddress As String
  Dim TheBody As String


  Set MyDB = CurrentDb
  Set MyRS = MyDB.OpenRecordset("test")
    MyRS.MoveFirst
  
  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

  Do Until MyRS.EOF
  ' Create the e-mail message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
  TheAddress = MyRS![Email]

  TheBody ="<p style='font-family:Tahoma;'>Account Number: " & MyRS![Customer_Number] & _
"<p style='font-family:Tahoma;'>Hi " & MyRS![Forename] & " <sp> " & MyRS![Surname] & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<p style='font-family:Tahoma;'>Test Here</p>" & _
"<h2 style='text-align:Left;'><strong></strong></h2>"


     With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add(TheAddress)
        objOutlookRecip.Type = olBCC

      
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .To = TheAddress
        .Subject = "Test"
        .HTMLBody = TheBody   
          
      
  
        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
           If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
           End If
        Next
        .Send
      End With
      MyRS.MoveNext
   Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:44
Joined
Sep 21, 2011
Messages
10,561
Look at SendUsingAccount.
Find the account index and use that when sending.

Code:
            If rs!ClientDivision = "SSW" Then
                Set objOutlookRecip = .Recipients.Add("Jim Needs - Personal")
                objOutlookRecip.Type = olTo
                intAccount = 2
            Else
'                Set objOutlookRecip = .Recipients.Add("SSAFA West Glamorgan Branch")
                Set objOutlookRecip = .Recipients.Add("South West Wales SSAFA")
                objOutlookRecip.Type = olTo
                intAccount = 3
            End If
More code

Inside the Outlook message loop
Code:
            .SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)
 

Number11

Member
Local time
Today, 07:44
Joined
Jan 29, 2020
Messages
476
sorted this added code to close outlook and load a different profile
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:44
Joined
Sep 21, 2011
Messages
10,561
sorted this added code to close outlook and load a different profile
Well, that is another way I suppose.

However I would have thought you would need to make note of which profile was loaded previously, so you can put Outlook back as it was, before you ran your code?
 

Users who are viewing this thread

Top Bottom