VBA-select a file to attach in email
Good morning, ladies and gentlemen, this is my first question. I never did, because I always find the answer in some forum, but this time, I lost! Then let's my doubt.
I used a mixture of codes on the internet to create this routine that enters gmail via Internet Explorer, creates a new message, tries to attach a file and sends it.
(I did not use sending via smtp, because the only port that the proxy of my work releases, is the :8080)
For the code to work you must configure your email with the default email preview HTML.
Only when it comes to attaching, it opens the FileDialog and I don't know what code I write to write the file I want to select.
I did a research on FileDialog, but they only teach you how to work with the dialog you created and not one opened by the system.
I have been in this suffering for three days!
Code that opens IE and access gmail, and log in if necessary
It is worth noting that as the internet here is slow there is a loop to wait the page is ready and a function with a delay.
For the routine to work you need to add, in the References tab, the two libraries listed below:
Microsoft Internet Controls;
Microsoft HTML object Library;
Public Sub EnviarEmail()
Dim ie As New SHDocVw.InternetExplorer
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLElement As MSHTML.IHTMLElement
Dim HTMLInput As MSHTML.HTMLInputElement
Dim HTMLAnch As MSHTML.HTMLAnchorElement
Open IE and access gmail;
With ie
.Visible = True
.Silent = True
.navigate "https://accounts.google.com/signin/v2/identifier?continue=https%3A%2F%2Fmail.google.com%2Fmail%2F&service=mail&sacu=1&rip=1&flowName=GlifWebSignIn&flowEntry=ServiceLogin"
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(2)
Set HTMLDoc = ie.Document
Log in if necessary;
For Each HTMLInput In HTMLDoc.all
If HTMLInput.getAttribute("name") = "identifier" Then
HTMLDoc.all.identifier.Value = "Meu Login"
HTMLDoc.all.identifierNext.Click
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(2)
For Each HTMLElement In HTMLDoc.getElementsByName("password")
If HTMLElement.getAttribute("type") = "password" Then
HTMLElement.Value = "Minha Senha"
Exit For
End If
Next HTMLElement
HTMLDoc.all.passwordNext.Click
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(4)
Exit For
End If
Next
Look for the link to write Email and click;
For Each HTMLAnch In HTMLDoc.all
If Len(HTMLAnch.href) > 16 Then
If Right(HTMLAnch.href, 16) = "?&cs=b&pv=tl&v=b" Then
HTMLAnch.Click
Exit For
End If
End If
Next
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(6)
Fills in the email fields;
HTMLDoc.all("to").innerText = "[email protected]"
HTMLDoc.all("subject").innerText = "Assunto"
HTMLDoc.all("body").innerText = "Corpo do email"
Look for the button to attach the file and click;
For Each HTMLInput In HTMLDoc.all
If HTMLInput.getAttribute("name") = "file0" Then
HTMLInput.Click
Exit For
End If
Next
At this point, the FileDialog box opens to select the file. And I'm not knowing how to write the name of the file to be selected and attached to the email.
Qual o código insiro aqui?
Look for the Send email button and click to send;
For Each HTMLInput In HTMLDoc.all
If HTMLInput.getAttribute("name") = "nvp_bu_send" Then
HTMLInput.Click
Exit For
End If
Next
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Finish O IE E ends the routine;
ie.Quit
Set ie = Nothing
Set HTMLDoc = Nothing
Set HTMLElement = Nothing
Set HTMLAnch = Nothing
End Sub
Here follows the waiting routine.
Public Sub WaitAFewSeconds(ByVal tempo As Integer)
Dim sngStart As Single
Dim PAUSE_TIME As Integer
PAUSE_TIME = tempo 'seconds
sngStart = Timer
Do Until Timer - sngStart > PAUSE_TIME
DoEvents
Loop
End Sub
I'm sorry if I was too verbose!
Right now, thank you for your attention.
1 answers
AutoIt
The solution found uses the AutoIt script externally to the VBA, because the VBA is crashing as soon as the upload window is opened and only resumes the code when it is closed.
The same AutoIt action can be performed in VBA with WinAPI or by adding the AutoIt reference. If the error of locking the code is fixed these solutions in VBA can be implemented.
Code
#include <IE.au3>
#include <MsgBoxConstants.au3>
Sleep(5000)
$hChoose = WinWait("Escolher arquivo a carregar")
$begin = TimerInit ()
Do
$dif = TimerDiff ($begin)
;MsgBox ( $MB_OK, "Aviso", "Sucesso!" , 5 )
Sleep(2500)
Until WinExists("[CLASS:#32770; TITLE:Escolher arquivo a carregar]") or $dif>20000
$arquivo = "C:\TestFolder\Bo ok1.pdf"
ControlSetText($hChoose, "", "Edit1", $arquivo)
Sleep(500)
ControlClick($hChoose, "", "[TEXT:&Abrir]")
;MsgBox ( $MB_OK, "Aviso", "Fim" , 5 )
VBA
Then the AutoIt script is called in VBA before opening the upload window.
Code
Dim CaminhoAutoIt As String, CaminhoScript As String
Dim AbrirScript
CaminhoAutoIt = """C:\Program Files (x86)\AutoIt3\AutoIt3_x64.exe"""
CaminhoScript = """C:\Excel\testes\Janela Escolha arquivo a carregar2.au3"""
AbrirScript = Shell(CaminhoAutoIt + " " + CaminhoScript, vbNormalFocus)
Final Code
Public Sub EnviarEmail()
Dim ie As New SHDocVw.InternetExplorer
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLElement As MSHTML.IHTMLElement
Dim HTMLInput As MSHTML.HTMLInputElement
Dim HTMLAnch As MSHTML.HTMLAnchorElement
Dim sFilename As String, sFilepath As String
Dim objStream As Object
Dim strData As String, str As String
Set objStream = CreateObject("ADODB.Stream")
sFilename = "temp.txt"
sFilepath = ThisWorkbook.Path & "\" & sFilename
With ie
.Visible = True
.Silent = True
.navigate "https://mail.google.com/mail/u/0/h/eofyx79x3pkg/?zy=e&f=1"
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(2)
Set HTMLDoc = ie.document
For Each HTMLInput In HTMLDoc.all
If HTMLInput.getAttribute("name") = "identifier" Then
HTMLDoc.all.identifier.Value = "CONTA"
HTMLDoc.all.identifierNext.Click
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(2)
For Each HTMLElement In HTMLDoc.getElementsByName("password")
If HTMLElement.getAttribute("type") = "password" Then
HTMLElement.Value = "SENHA"
Exit For
End If
Next HTMLElement
HTMLDoc.all.passwordNext.Click
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(4)
Exit For
End If
Next
For Each HTMLAnch In HTMLDoc.all
If Len(HTMLAnch.href) > 16 Then
If Right(HTMLAnch.href, 16) = "?&cs=b&pv=tl&v=b" Then
HTMLAnch.Click
Exit For
End If
End If
Next
With ie
Do While .Busy Or .readyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
Call WaitAFewSeconds(6)
HTMLDoc.all("to").innerText = "[email protected]"
HTMLDoc.all("subject").innerText = "Assunto"
HTMLDoc.all("body").innerText = "Corpo do email"
Dim CaminhoAutoIt As String, CaminhoScript As String
Dim AbrirScript
CaminhoAutoIt = """C:\Program Files (x86)\AutoIt3\AutoIt3_x64.exe"""
CaminhoScript = """C:\Daniel Takeshi\Excel\testes\Janela Escolha arquivo a carregar2.au3"""
AbrirScript = Shell(CaminhoAutoIt + " " + CaminhoScript, vbNormalFocus)
For Each HTMLInput In HTMLDoc.all
If HTMLInput.getAttribute("name") = "file0" Then
HTMLInput.Click
DoEvents
Sleep 200
Exit For
End If
Next
'ie.Quit
'
'Set ie = Nothing
'Set HTMLDoc = Nothing
'Set HTMLElement = Nothing
'Set HTMLAnch = Nothing
End Sub
Public Sub WaitAFewSeconds(ByVal tempo As Integer)
Dim sngStart As Single
Dim PAUSE_TIME As Integer
PAUSE_TIME = tempo 'seconds
sngStart = Timer
Do Until Timer - sngStart > PAUSE_TIME
DoEvents
Loop
End Sub
Obs.: Times can be decreased or increased, it depends on each internet network and computer the processing time of this code.