Sending Emails to Outlook accounts using VBA Macro

Priyantha
StarLounger
Posts: 86
Joined: 10 Oct 2022, 02:52

Sending Emails to Outlook accounts using VBA Macro

Post by Priyantha »

Dear All,

I use a macro (Excel file attached) to sent emails with attachment based on Gmail account. Although All mail were set to Gmail account, no sent mails to outlook accounts. please help me solve this issue. (my Outlook address - Priyantha.Gamini@ceb.lk)

My Code :

Option Explicit
'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail_Welser()

Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String
Dim last_row As Long
Dim ws6 As Worksheet
Dim attachment_path As String
Dim j As Long
Dim k As Long
Dim Attach As String
Dim AttachExists As String
Dim rowCounter As Long
Dim folderpath As String

Set ws6 = ThisWorkbook.Sheets("Thirdparty")
rowCounter = 1
folderpath = Application.ActiveWorkbook.Path

last_row = 3
Do While ws6.Cells(last_row + 1, 2).Value <> ""
last_row = last_row + 1
Loop

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Sort as Thirdpaarty Code''
Dim Rng As Range
Dim SRng As Range

Set Rng = ws6.Range(Cells(3, 2), ws6.Cells(last_row, "J"))
Set SRng = ws6.Range(Cells(3, 2), ws6.Cells(last_row, "B"))

Rng.Sort Key1:=SRng, Order1:=xlAscending, Header:=xlYes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For j = 4 To last_row

''''''Blank Cell Hide'''''
If ws6.Cells(j, 9).Value = "" Then
ws6.Rows(j).Hidden = True
ElseIf ws6.Cells(j, 9).Value = 0 Then
ws6.Rows(j).Hidden = True
End If

'''''' Not Value in colum "I _ Amount" Or No Email Address ''''
If ws6.Cells(j, 9).Value = "" Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
ElseIf ws6.Cells(j, 9).Value = 0 Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
ElseIf ws6.Cells(j, 5).Value = "" Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
End If

Attach = folderpath & "\Thirdparty Letters\" & ws6.Cells(j, 2).Value & ".pdf"

''''' If Without Attachment '''''
AttachExists = Dir(Attach)

If AttachExists = "" Then
ws6.Cells(j, 10).Value = "No Sent"
MsgBox "No Attachment for " & ws6.Cells(j, 2).Value
GoTo NextID
Else
ws6.Cells(j, 10).Value = "Sent"
End If

On Error GoTo Err:

'late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

' load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

'Set All Email Properties
With NewMail
.From = "salary2.lvpp@gmail.com"
.To = ws6.Cells(j, 5).Value
.CC = ""
.BCC = ""
.Subject = "Thirdparty Remitance For the Month of " & ws6.Range("E1").Value
.TextBody = "Dear Sir/Madam," & vbNewLine & vbNewLine & "The state of Remitance to " & ws6.Cells(j, 4).Value & " for the month of " & ws6.Range("E1").Value & " are attached here with." & vbNewLine & vbNewLine & "Best Regards," & vbNewLine & vbNewLine & "I.W. Karunarathna," & vbNewLine & "Accountant (Payment & Payroll)," & vbNewLine "
.AddAttachment Attach

End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields
.Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
.Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
.Item(msConfigURL & "/smtpserverport") = 465 'Set the SMTP port Details
.Item(msConfigURL & "/sendusing") = 2 'Send using default setting
.Item(msConfigURL & "/sendusername") = "salary2.lvpp@gmail.com" 'Your gmail address
.Item(msConfigURL & "/sendpassword") = "ahnp hfhg zvou mcvt" 'Your password or App Password
.Update 'Update the configuration fields
End With

NewMail.Configuration = mailConfig
NewMail.Send

NextID:
Application.Wait (Now + TimeValue("0:00:01"))

'''' Status Bar'''''''
Application.StatusBar = "Progress: " & "Code No.. : " & ws6.Cells(j, 2).Value & " - " & ws6.Cells(j, 4).Value & " " & j - 3 & " of " & last_row - 3 & " : " & Format((j - 3) / (last_row - 3), "0%")

'' Serial Numbers'''
If ws6.Rows(j).Hidden = False Then
Range("A" & j).Value = rowCounter
rowCounter = rowCounter + 1
End If

Next j
MsgBox "All email has been sent", vbInformation

Exit_Err:
'Release object memory
Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.Number
Case -2147220973 'Could be because of Internet Connection
MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
Case -2147220975 'Incorrect credentials User ID or password
MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
Case Else 'Report other errors
MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select

Resume Exit_Err

End Sub

Thanks,

Priyantha
You do not have the required permissions to view the files attached to this post.
Top
User avatar
DocAElstein
4StarLounger
Posts: 584
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Sending Emails to Outlook accounts using VBA Macro

Post by DocAElstein »

Hello
There is a s mall typo in your posted code "
"Dear Sir/Madam," & vbNewLine & vbNewLine & "The state of Remitance to " & ws6.Cells(j, 4).Value & " for the month of " & ws6.Range("E1").Value & " are attached here with." & vbNewLine & vbNewLine & "Best Regards," & vbNewLine & vbNewLine & "I.W. Karunarathna," & vbNewLine & "Accountant (Payment & Payroll)," & vbNewLine "
But I do not think that is main problem, because that typo is not in the code in your uploaded file.

I do not know what your problem is. Perhaps there is some corruption in your file.
But I am not sure.
When I try to use you file I get big problems. I get errors, or Excel crashes, or my computer crashes. Your file is much too complicated for me to work with. There are lots of complicated things which I do not understand and which cause me to have errors and crashes in Excel and in my computer. Perhaps you have hidden and protected things in your file. (It is better when you ask us for help to try and reduce everything you give us to the minimum amount required to demonstrate your problem)



However,
I think there is not a major problem with your coding for Sending Emails.
I think there is not a major problem with your coding for Sending Emails to Outlook accounts.

I have successfully sent Emails using your coding in uploaded file, Test Priyantha CDO send macro.xlsm.

I have used 4 of my accounts to send to: a German Telekom, a gmail, and two Outlook accounts
xxxxx@t-online.de
xxxxx@gmail.com
xxxxx@outlook.com
xxxxxxxg@outlook.de
I used your coding (including your gmail in the coding to do the sending, )
All have worked, I recieved all Emails, many times:
https://i.postimg.cc/gJtHgGyQ/Worked-gmail-com.jpg
https://i.postimg.cc/J0ycgSPn/Worked-outlook-de.jpg
https://i.postimg.cc/W4KYp4v7/Worked-outlook-com.jpg
https://i.postimg.cc/1z4YZqLt/Worked-t-online-de.jpg

Only sometimes I get warning on Outlook.
https://i.postimg.cc/T3jSCWKs/Outlook-Warning.jpg
Then if I remove warning all is OK


I think your coding is OK.
I think there may be some problem in you file. But it is much too complicated for me to look at it further. Your file causes problems for me, and crashes in my Excel



This macro works consistently for me

Code: Select all

see next post




( I have used a test pdf as attachment in my coding. I saved it in same place as main file - https://i.postimg.cc/JhR1qkQ6/Save-pdf- ... m-file.jpg )




Alan
You do not have the required permissions to view the files attached to this post.
Last edited by DocAElstein on 05 Feb 2024, 19:00, edited 6 times in total.
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(
Top
User avatar
DocAElstein
4StarLounger
Posts: 584
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Sending Emails to Outlook accounts using VBA Macro

Post by DocAElstein »

Coding for last post

Code: Select all

Option Explicit
'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail_Welser()
                       
Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String
Dim last_row As Long
Dim ws6 As Worksheet
Dim attachment_path As String
Dim j As Long
Dim k As Long
Dim Attach As String
Dim AttachExists As String
Dim rowCounter As Long
Dim folderpath As String

Set ws6 = ThisWorkbook.Sheets("Thirdparty")
rowCounter = 1
folderpath = Application.ActiveWorkbook.Path

last_row = 3
Do While ws6.Cells(last_row + 1, 2).Value <> ""
last_row = last_row + 1
Loop

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Sort as Thirdpaarty Code''
Dim Rng As Range
Dim SRng As Range

Set Rng = ws6.Range(Cells(3, 2), ws6.Cells(last_row, "J"))
Set SRng = ws6.Range(Cells(3, 2), ws6.Cells(last_row, "B"))

Rng.Sort Key1:=SRng, Order1:=xlAscending, Header:=xlYes
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

For j = 4 To last_row

    ''''''Blank Cell Hide'''''
If ws6.Cells(j, 9).Value = "" Then
ws6.Rows(j).Hidden = True
ElseIf ws6.Cells(j, 9).Value = 0 Then
ws6.Rows(j).Hidden = True
End If

    '''''' Not Value in colum "I _ Amount" Or No Email Address ''''
If ws6.Cells(j, 9).Value = "" Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
ElseIf ws6.Cells(j, 9).Value = 0 Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
ElseIf ws6.Cells(j, 5).Value = "" Then
ws6.Cells(j, 10).Value = "No Sent"
GoTo NextID
End If
        
'Attach = folderpath & "\Thirdparty Letters\" & ws6.Cells(j, 2).Value & ".pdf"
Attach = ThisWorkbook.Path & "\Testpdf.pdf"
    
    ''''' If Without Attachment '''''
AttachExists = Dir(Attach)
    
If AttachExists = "" Then
ws6.Cells(j, 10).Value = "No Sent"
MsgBox "No Attachment for " & ws6.Cells(j, 2).Value
GoTo NextID
Else
ws6.Cells(j, 10).Value = "Sent"
End If
            
On Error GoTo Err:

    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields

    'Set All Email Properties
    With NewMail
        .From = "xxxxx@xxxxxxxx"
        .To = ws6.Cells(j, 5).Value
        .CC = ""
        .BCC = ""
        .Subject = "Thirdparty Remitance For the Month of   " & ws6.Range("E1").Value
        .TextBody = "Dear  Sir/Madam," & vbNewLine & vbNewLine & "The state of Remitance to " & ws6.Cells(j, 4).Value & "  for the month of " & ws6.Range("E1").Value & " are attached here with." & vbNewLine & vbNewLine & "Best Regards," & vbNewLine & vbNewLine & "I.W. Karunarathna," & vbNewLine & "Accountant (Payment & Payroll)," & vbNewLine
        .AddAttachment Attach
        
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
        .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
        .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
        .Item(msConfigURL & "/sendusername") = "xxxxxxxx.com" 'Your gmail address
        .Item(msConfigURL & "/sendpassword") = "xxxxxxxxx" 'Your password or App Password
        .Update                                               'Update the configuration fields
    End With
    
    NewMail.Configuration = mailConfig
    NewMail.Send
    
NextID:
Application.Wait (Now + TimeValue("0:00:01"))

                    '''' Status Bar'''''''
Application.StatusBar = "Progress:  " & "Code No.. : " & ws6.Cells(j, 2).Value & " - " & ws6.Cells(j, 4).Value & "   " & j - 3 & " of " & last_row - 3 & "   : " & Format((j - 3) / (last_row - 3), "0%")
     
    '' Serial Numbers'''
If ws6.Rows(j).Hidden = False Then
Range("A" & j).Value = rowCounter
rowCounter = rowCounter + 1
End If
                 
Next j
MsgBox "All email has been sent", vbInformation
            
Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

_.___________________________________________________________________________________________________


I have also sent you a file,
Test Priyantha CDO send macro real Outlook.xlsm
, by PM (Private Message). That has real Outlook Email addresses and passwords of mine and yours.



Alan
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(
Top
Priyantha
StarLounger
Posts: 86
Joined: 10 Oct 2022, 02:52

Re: Sending Emails to Outlook accounts using VBA Macro

Post by Priyantha »

Dear, DocAElstein,

Many thanks for paying attention to my problem.

Email Massage was receved, to my Outlook email address (Priyantha.Gamini@ceb.lk) with my attachment file sent by this Gmail Address (salary2.lvpp@gmail.com) without running the macro. But while i tring to send mail with same ataachment using the macro, The mail does not receive. Don't understand what the problem is. Sometimes it is doubtful whether the messages sent by the macro will be blocked by my Outlook email address. Is there a solution to this?

BR,

Priyantha.
Top
User avatar
DocAElstein
4StarLounger
Posts: 584
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Sending Emails to Outlook accounts using VBA Macro

Post by DocAElstein »

Hello,
I only have some knowledge of CDO sending coding. These can be reliable sometimes for me.
I do not have much experience with Outlook.
I also did sometimes experience that my Outlook email address blocked some things. Because of this annoying blocking, I do not use Outlook much anymore.
So I probably cannot help you much more.

I can only give two wild guesses:

_ Maybe a solution would be for you to use a different address email for receiving, and not Outlook

_ Another possibility could be that Outlook may block sometimes things that are automated by Gmail, because
, Outlook is part of Microsoft
, Gmail is part of Google.
Microsoft and Google do not like each other and in the past they have tried to cause problems to each other
So you could try a different Email provider for the ssending


I don’t think can I help you much more.
But I will do a couple of experiments with sending just now, then perhaps post once again with Results
I will do two experiments

_A) I will run macro Sub SendEmailUsingGmail_Welser() , in file Test Priyantha CDO send macro real Outlook.xlsm.
( You have this file already from a PM to you from yesterday )
Sub SendEmailUsingGmail_Welser() will try to send to
My ____@Outlook.com
My ____@outlook.de
Your ____@ceb.lk
It will use your gmail for sending ( .Item(msConfigURL & "/sendusername") = "____@gmail.com" )


_B) I will run Sub SendEmailUsingGmail_WelserTelekom() , in file Test Priyantha CDO send macro real OutlookTelekom.xlsm
( I will send you this file in a second PM )
Sub SendEmailUsingGmail_WelserTelekom() is slightly different to Sub SendEmailUsingGmail_Welser()
Sub SendEmailUsingGmail_WelserTelekom() does not use Gmail to send. It uses a spare German Telekom account of mine.
Sub SendEmailUsingGmail_WelserTelekom() will try to send to
My ____@Outlook.com
My ____@outlook.de
Your ____@ceb.lk
It will use my German Telekom for sending ( .Item(msConfigURL & "/sendusername") = "____@t-online.de" )

I will post again later , and tell you what happened.
Last edited by DocAElstein on 07 Feb 2024, 08:52, edited 4 times in total.
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(
Top
User avatar
DocAElstein
4StarLounger
Posts: 584
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Sending Emails to Outlook accounts using VBA Macro

Post by DocAElstein »

Results

_A) I did run Sub SendEmailUsingGmail_Welser()
It did arrive at ___@outlook.de from ___@gmail.com https://i.postimg.cc/cCfnFf9F/It-did-ar ... -gmail.jpg
It did arrive at ___@outlook.com from ___@gmail.com https://i.postimg.cc/RCtKCzSw/It-did-ar ... -gmail.jpg

They did arrive, 6 February, 22.01 ( German time - Zeitzone. MEZ (Mitteleuropäische Zeit) UTC/GMT +1 )



_B) I did run Sub SendEmailUsingGmail_WelserTelekom()
It did arrive at ___@outlook.de from ___@t-online.de , But it arrived in Spam folder https://i.postimg.cc/029g1Rpy/It-did-ar ... folder.jpg
It did arrive at ___@outlook.com from ___@t-online.de , But it arrived in Spam folder https://i.postimg.cc/GtYNYR66/It-did-ar ... folder.jpg

They did arrive, 6 February, 22.17 ( German time - Zeitzone. MEZ (Mitteleuropäische Zeit) UTC/GMT +1 )



I do not know if that is any help to you


Alan
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(
Top
Priyantha
StarLounger
Posts: 86
Joined: 10 Oct 2022, 02:52

Re: Sending Emails to Outlook accounts using VBA Macro

Post by Priyantha »

Dear Alan,

I got your (edited) code and i tried to send mails to outlook. It woked me .After i add my deta (Email address and password) it woked. I dont know wthat happened but macro was woked Thank you so much for Regarding your knowledge and time to solve my problem

Br,

Priyantha

Sub SendEmailUsingGmail_WelserTelekom()
Top

Return to “VB/VBA/.Net/Office Scripting”