Compose mail in gmail VBA

ExcelTheCell

Board Regular
Joined
Nov 14, 2010
Messages
158
Code:
IE.Navigate "[URL]https://mail.google.com/mail/u/0/#inbox[/URL]"
I'm allways sign in. All i need is code that will click on Compose button and insert text in fileds TO,BODY and send to recipient, and possible to sign out from account
Any easy way...
 
Last edited:
I have seen that message was delivered... on gmail... I'm using Excel 2007 and/or 2010 it depends on what computer am I.
I will check maybe i have some security firewall settings then or something else.
Thank you for your time Andrew Poulsom
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Well i was studying the code and woulld't want to connect over SMPT way... I have made code all to the compose mail part where im stucked.

From Andrew Poulsom was great idea but i would like to do this way and i need your help.
Basicly from this point i need to do assign next steps:
-Fill textarea To
-Fill textarea Subject
-Click Send Image
-Logout

Here is code that I have so far:

PHP:
Private Sub GenerateMailGail()
'Definine constants
Const NavigationUrl = "http://mail.google.com"
Const Username = "mrexceltest@gmail.com"
Const Password = "mrexceltest321"
'Define dimensions
Dim IEX As InternetExplorer
Dim IEXDoc As HTMLDocument '---------->Returns an HTMLDocument object that specifies _
                                                                          the HTML object model associated with the HTML _
                                                                          document in the current view (assuming one exists).
Dim IEXLF As HTMLFormElement
Dim UserNameInputBox As HTMLInputElement
Dim PasswordInputBox As HTMLInputElement
Dim SignInButton As HTMLInputButtonElement
 
'Action to navigate to the specific site
Set IEX = New InternetExplorer
IEX.Visible = True
IEX.Navigate NavigationUrl
Do While IEX.ReadyState <> 4 Or IEX.Busy: DoEvents: Loop

Set IEXDoc = IEX.Document 'you get [object]

On Error GoTo NextStep
'Data found in sorce code of the HTML page
'<form id="gaia_loginform" action="https://accounts.google.com/ServiceLoginAuth" method="post">
Set IEXLF = IEXDoc.forms("gaia_loginform")

'Data found in source code of the HTML page
'<div class="email-div">
'<label for="Email"><strong class="email-label">Username</strong></label>
'<input  type="text" spellcheck="false" _
    name="Email" id="Email" value="">
'</div>
Set UserNameInputBox = IEXLF.elements("Email")
      UserNameInputBox.Value = Username
      
'Data found in source code of the HTML page
'<div class="passwd-div">
'<label for="Passwd"><strong class="passwd-label">Password</strong></label>
'<input  type="password" name="Passwd" id="Passwd">
'</div>
 Set PasswordInputBox = IEXLF.elements("Passwd")
    PasswordInputBox.Value = Password

'Data found in source code of the HTML page
'<input type="submit" class="g-button g-button-submit" name="signIn" id="signIn" value="Submit">
Set SignInButton = IEXLF.elements("signIn")
SignInButton.Click
NextStep:
Const NavigationCompose = "https://mail.google.com/mail/u/0/#compose"
Dim EmailForm As HTMLFormElement
Dim TableSelection As HTMLTable

IEX.Navigate "https://mail.google.com/mail/u/0/#compose"
Do While IEX.ReadyState <> 4 Or IEX.Busy: DoEvents: Loop

Application.Wait Now + TimeValue("00:00:05")
IEX.Quit
End Sub
</FORM>
 
Last edited:
Upvote 0
Hello All: I have Excel 2007 and maybe that is why it doesnt work. Here is the code I use. The error I get is always on the last part ".Send"

Option Explicit


Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dudde"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "My pass goes here and it does not work"
.Item("http://schemas.microsoft.com/cdo/configuration/sendserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 (I've tried 465)
.Update
End With


strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"


With iMsg
Set .Configuration = iConf
.To = "Mail address receiver"
.CC = "dude"
.BCC = ""
.ReplyTo = "dude@rangel.pt"
.From = """Antonio"" <dude@gmail.com>"
.Subject = "Important message"
.TextBody = strbody
.Send (here is where the debug error thing comes in)
End With
End Sub
 
Upvote 0
Hi Antonio,

Try to add this code to the module and call them in the code that you have send. Then try again if not then we have same problem... I decided with diferent aproach because of that.

Code:
Function AddIEFRAME()
'Add referance from library named Microsoft internet contol
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\ieframe.dll")
1:
End Function
Function AddMsHtml()
'Add referance from library named Microsoft HTML object library
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\MsHtml.tlb")
1:
End Function
Function AddCDOWIN()
'Add referance from library named Microsoft CDO for WIn 2000 library
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\cdosys.dll")
1:
End Function

Br,

Ps. Place always your code in inside of
Code:
 
Last edited:
Upvote 0
Thank you for the quick reply:

My code is on module 1. Ive tried adding your code in several different places and since I dont know much about vba/cdo etc, I'm pretty sure Im placing it on the wrong place.
My code is the following: (could you please copy paste my code and then add your code so that I understand where I should put your code). Thanx again:

Hello All: I have Excel 2007 and maybe that is why it doesnt work. Here is the code I use. The error I get is always on the last part ".Send"

Option Explicit


Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "dudde"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "My pass goes here and it does not work"
.Item("http://schemas.microsoft.com/cdo/configuration/sendserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 (I've tried 465)
.Update
End With


strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"


With iMsg
Set .Configuration = iConf
.To = "Mail address receiver"
.CC = "dude"
.BCC = ""
.ReplyTo = "dude@rangel.pt"
.From = """Antonio"" <dude@gmail.com style="color: rgb(51, 51, 51); background-color: rgb(250, 250, 250); ">"
.Subject = "Important message"
.TextBody = strbody
.Send (here is where the debug error thing comes in)
End With
End Sub</dude@gmail.com>
 
Upvote 0
Here you go.

Code:
Function AddIEFRAME()
'Add referance from library named Microsoft internet contol
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\ieframe.dll")
1:
End Function
Function AddMsHtml()
'Add referance from library named Microsoft HTML object library
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\MsHtml.tlb")
1:
End Function
Function AddCDOWIN()
'Add referance from library named Microsoft CDO for WIn 2000 library
On Error GoTo 1
ThisWorkbook.VBProject.References.AddFromFile ("C:\WINDOWS\System32\cdosys.dll")
1:
End Function
Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Call AddIEFRAME
Call AddMsHtml
Call AddCDOWIN
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("[URL]http://schemas.microsoft.com/cdo/con...ion/smtpusessl[/URL]") = True
.Item("[URL]http://schemas.microsoft.com/cdo/con...tpauthenticate[/URL]") = 1
.Item("[URL]http://schemas.microsoft.com/cdo/con...n/sendusername[/URL]") = "dudde"
.Item("[URL]http://schemas.microsoft.com/cdo/con...n/sendpassword[/URL]") = "My pass goes here and it does not work"
.Item("[URL]http://schemas.microsoft.com/cdo/con...ion/sendserver[/URL]") = "smtp.gmail.com"
.Item("[URL]http://schemas.microsoft.com/cdo/con...tion/sendusing[/URL]") = 2
.Item("[URL]http://schemas.microsoft.com/cdo/con...smtpserverport[/URL]") = 25 (I've tried 465)
.Update
End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "Mail address receiver"
.CC = "dude"
.BCC = ""
.ReplyTo = "[EMAIL="dude@rangel.pt"]dude@rangel.pt[/EMAIL]"
.From = """Antonio"" "
.Subject = "Important message"
.TextBody = strbody
.Send (here is where the debug error thing comes in)
End With
End Sub
 
Upvote 0
Thanks but I continue to get the error. I'm going to try it on my home PC, maybe its a antivirus thing.
 
Upvote 0
If you are in big company then it's possible that they have set firewall for SMTP setting... Thats why I'm trying to make workaround with different aproach. And hoping for help from MVP masters
Code:
Private Sub GenerateMailGail()
'Definine constants
Const NavigationUrl = "[URL]http://mail.google.com[/URL]"
Const Username = "[EMAIL="mrexceltest@gmail.com"]mrexceltest@gmail.com[/EMAIL]"
Const Password = "mrexceltest321"
'Define dimensions
Dim IEX As InternetExplorer
Dim IEXDoc As HTMLDocument '---------->Returns an HTMLDocument object that specifies _
                                                                          the HTML object model associated with the HTML _
                                                                          document in the current view (assuming one exists).
Dim IEXLF As HTMLFormElement
Dim UserNameInputBox As HTMLInputElement
Dim PasswordInputBox As HTMLInputElement
Dim SignInButton As HTMLInputButtonElement
 
'Action to navigate to the specific site
Set IEX = New InternetExplorer
IEX.Visible = True
IEX.Navigate NavigationUrl
Do While IEX.ReadyState <> 4 Or IEX.Busy: DoEvents: Loop
Set IEXDoc = IEX.Document 'you get [object]
On Error GoTo NextStep
'Data found in sorce code of the HTML page
'<FORM id=gaia_loginform action="<a href=" target=_blank ServiceLoginAuth? accounts.google.com https:>https://accounts.google.com/ServiceLoginAuth</A>" method="post">
Set IEXLF = IEXDoc.forms("gaia_loginform")
'Data found in source code of the HTML page
'
'<LABEL for=Email>[B]Username[/B]</LABEL>
'<INPUT spellcheck="false" _
        name="Email" id="Email" value="">
'

Set UserNameInputBox = IEXLF.elements("Email")
      UserNameInputBox.Value = Username
      
'Data found in source code of the HTML page
'
'<LABEL for=Passwd>[B]Password[/B]</LABEL>
'<INPUT id=Passwd name=Passwd  type="password">
'

 Set PasswordInputBox = IEXLF.elements("Passwd")
    PasswordInputBox.Value = Password
'Data found in source code of the HTML page
<INPUT id=signIn class="g-button g-button-submit" value=Submit type=submit name=signIn>
Set SignInButton = IEXLF.elements("signIn")
SignInButton.Click
NextStep:
Const NavigationCompose = "[URL]https://mail.google.com/mail/u/0/#compose[/URL]"
Dim EmailForm As HTMLFormElement
Dim TableSelection As HTMLTable
IEX.Navigate "[URL]https://mail.google.com/mail/u/0/#compose[/URL]"
Do While IEX.ReadyState <> 4 Or IEX.Busy: DoEvents: Loop
Application.Wait Now + TimeValue("00:00:05")
IEX.Quit
Exit Sub
</FORM>
 
Last edited:
Upvote 0
Yes I checked, the Mcfee is blocking it. So Im thinking that at my home pc it might work. I'll let you know if it does. In the mean time, since the company uses microsoft exchange, what I'm going to do is use that to try to send the email. Still stuck but I'm trying it. If and when it works I'll paste the code here just for everybody to know. This is pretty cool, thanks a lot for all your help this is by far the most interesting excel forum out there.
 
Upvote 0

Forum statistics

Threads
1,216,105
Messages
6,128,859
Members
449,472
Latest member
ebc9

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top