# Sending Emails Using Non-Default Account



## JediMindTricks (Dec 13, 2018)

Hey guys, I have a macro that's been working perfectly for years which would create an email for each invoice on each separate sheet, to an email address listed in a cell on each page, while at the same time creating a pdf of the individual excel page and attaching it to the email. The emails would be sent from my primary outlook account, which was a gmail account at the time. Worked great until I installed an exchange account on outlook, which "took over" outlook as my default send mail account.

The current excel macro is this:


Sub Send()
Dim fName As String, i As Integer, Mail_Object, o As Variant, ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "_Name of Excluded Sheet 1_" And ws.Name <> "_Name of Excluded Sheet 2_" And ws.Name <> "_Name of Excluded Sheet 3_" Then
ws.Activate
With ActiveSheet
fpath = "C:\temp"
fName = .Range("A2").Value
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fpath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "_Subject Heading for Email_" ' CHANGE TO SUIT
            .To = Range("_B2_").Value 'CHANGE TO SUIT
            .Body = "_Comments in the body of the Email_" 'change comments to suit
            .Attachments.Add fpath & fName & ".PDF"
            '.Send
            .display
    End With
End If
Next ws
End Sub
The macro will only send from the exchange account. I would like the macro to send from my gmail.com account, which is no longer the default mail account in Outlook (and I can't make it as such).

Does anyone have any idea how to modify my current macro to send from a non-default account in Outlook? Any help appreciated! 
Thanks for any suggestions. My experience is extremely limited (almost none) and I am looking for help.


----------



## JediMindTricks (Dec 13, 2018)

Here is the original macro:


```
[COLOR=#333333]Code:[/COLOR]Sub Send()
Dim fName As String, i As Integer, Mail_Object, o As Variant, ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Shift Log" And ws.Name <> "Pay" And ws.Name <> "Shift Payment" Then
ws.Activate
With ActiveSheet
fpath = "C:\temp\"
fName = .Range("A2").Value
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fpath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "Monthly Statement" ' CHANGE TO SUIT
            .To = Range("G2").Value 'CHANGE TO SUIT
            .Body = "Please See Your Attached Monthly Statement" 'change comments to suit
            .Attachments.Add fpath & fName & ".PDF"
            '.Send
            .display
    End With
Next ws [COLOR=#333333]End Sub[/COLOR]
```


----------



## Logit (Dec 13, 2018)

.
This page will tell you everything :

https://www.rondebruin.nl/win/s1/cdo.htm


----------



## JediMindTricks (Jan 7, 2019)

I'm just getting to this after the holidays.  Thanks for the overview but I'm still having difficulty.  As mentioned, I'm not very good at writing my own macros.  The big question for me, is it possible to use this information to send each excel sheet as a pdf from a gmail account?  I don't want to send the sheets, but a pdf of each sheet.

Happy to donate to anyone who can write this out for me!  Either using my previous macro and going through Outlook or using the information provided by Logit as a new option.
Any help from someone who has Excel talents would be much appreciated


----------



## Logit (Jan 7, 2019)

.
I can do the coding if you are ok using Outlook.


----------



## JediMindTricks (Jan 8, 2019)

Logit said:


> .
> I can do the coding if you are ok using Outlook.



No problem using Outlook, the current macro I have was great, it would just create the 50 or so emails in Outlook, sent to an email address from a predetermined cell # on each sheet, the pdfs of that individual sheet as an attachment, a generic subject line, a generic body of text, all from my primary email address (gmail).  I even had it set up to exclude certain master sheets in the excel book.  It was great for years!

The problem was when my Outlook's primary email address became an exchange account, and all mail now tries to be forced through that account instead.  I don't know the macro code needed to force those emails to be from my gmail instead.  Very frustrating.

Any help would be fantastic.


----------



## Logit (Jan 8, 2019)

Sent you a private message.


----------



## JediMindTricks (Jan 13, 2019)

Hey there excel masters, this issue still remains a mystery and nobody has yet been able to solve this problem.

If someone out there believes this cannot be done, if you could kindly let me know, that would be great so I can stop looking for a solution.  If not, if anyone knows how to force an outlook "from" field used a macro from excel, please help 

I am trying to edit this current macro to send from a specific outlook account (it's gmail in this case), which I've now trimmed to the following:


```
Sub SendMonthlyEmails()
Dim fName As String, i As Integer, ws As Worksheet
Set MailItem = CreateObject("Outlook.Application")


For Each ws In Worksheets


If ws.Name <> "Excluded Sheet" Then
ws.Activate
With ActiveSheet
fpath = "C:\TempExcelMacros\"
fName = .Range("A2").Value
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fpath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With


        With MailItem.CreateItem(olMailItem)
            .Subject = "Monthly Statement" 
            .To = Range("G2").Value
            .Body = "Please see your attached statement"
            .Attachments.Add fpath & fName & ".PDF"
            .Display
        End With
End If
Next ws
End Sub
```


----------



## JediMindTricks (Jan 13, 2019)

I have a partial breakthrough!
This macro below works to force an email from my gmail account (it is the outapp.session.accounts.item(1) line!)
However, unlike previously with the macro above, where each individual sheet would be created as a pdf and added to the indidividual email, and then the macro would move on to the next email (perfect!)...

This one below keeps re-writing over and over again in one email, the "to" email address field, and keeps adding the next fname.pdf as an additional attachment.  It's caught in a loop somewhere and won't re-create a new email before changing the address and adding the sheet as a .pdf attachment.  Maybe someone can use this information to try and make it work?  It's driving me nuts.




```
Sub SendMonthlyEmails()
Dim fName As String, i As Integer, ws As Worksheet
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)


For Each ws In Worksheets


If ws.Name <> "Excluded Sheet" Then
ws.Activate
With ActiveSheet
fpath = "C:\TempExcelMacros\"
fName = .Range("A2").Value
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fpath & fName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
         
        With OutMail
            .Subject = "Monthly Statement"
            .To = Range("G2").Value
            .Body = "Please see your attached monthly statement"
            .Attachments.Add fpath & fName & ".PDF"
            .Display
            .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        End With
End If
Next ws
End Sub
```


----------



## JediMindTricks (Mar 21, 2019)

To anyone who has stumbled across this thread with a similar problem, I've finally figured it out.

The following macro will use Outlook to send any Excel sheet in the book as a pdf attachment, with an email address in cell G2 (changeable) to that email address.  This macro can force the Outlook email account (not necessarily the default account). 

In my case, my gmail account I wanted to use was account 1 [SendUsingAccount = OutApp.Session.Accounts.Item(1)].

This might require some experimentation to see which account is which number in your own Outlook.

The title of the attached pdf will be whatever is in cell A2 (changeable).
The body of the email message and the subject of the email can be changed below.
I have set the macro to display the emails prior to sending, so that you can click send on each one, but this can easily be removed to just send instead of previewing each message.

Let me know if you have any problems! Hope this works for you.



```
Sub SendEmails()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Dim ws As Worksheet


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Set OutApp = CreateObject("Outlook.Application")


    For Each ws In ActiveWorkbook.Worksheets
        If ws.Range("G2").Value Like "?*@?*.?*" Then
            ws.Activate
            With ActiveSheet
            fpath = "C:\TempExcelMacros\"
            fName = .Range("A2").Value
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=fpath & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        
            Set OutMail = OutApp.CreateItem(0)


            On Error Resume Next
            With OutMail
                .To = ws.Range("G2").Value
                .CC = ""
                .BCC = ""
                .Subject = "CUSTOMIZE"
                .Body = "CUSTOMIZE WHAT YOU WANT TO WRITE HERE"
                .Attachments.Add fpath & fName & ".PDF"
                .Display
                .SendUsingAccount = OutApp.Session.Accounts.Item(1)
            End With
            On Error GoTo 0


            Set OutMail = Nothing
        End If
    Next ws


    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
```


----------

