VBA - Select a file to attach in the email

Question

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! So let’s have my doubt.

I used a mix 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 send 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 view HTML.

Only at the time of attaching, it opens the Filedialog and I do not know which code I write to write the file I want to select.

I did a research on Filedialog, but only teach to work with the dialog you created and not one opened by the system.

I’ve been in this pain for three days!

Code that opens IE and accesses gmail, and logs in if necessary

Note that as the internet here is slow there is a loop to wait for 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

Find 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)

Fill in the email fields;

HTMLDoc.all("to").innerText = "[email protected]"

HTMLDoc.all("subject").innerText = "Assunto"    

HTMLDoc.all("body").innerText = "Corpo do email"

Find 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 exactly this point, the Filedialog box is opened to select the file. And I’m not sure how to write the file name to be selected and attached to the email.

Qual o código insiro aqui?

Find 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 the IE and finish 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 long!

Thanks for your attention.

Answer 1

Autoit

The solution found uses the Autoit script externally to the VBA, because the VBA is locking as soon as the upload window is opened and only restarts the code when it is closed.

The same action of Autoit can be performed in VBA with Winapi or by adding the Autoit reference. If the error to lock 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

After 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

Note: Times can be shortened or increased, it depends on each internet network and computer the processing time of this code.