VBA - Send email over fixed gmail with PDF attachment

[joshhargs]

Hello excel friends,

I have an issue trying to make a button to send an email containing a PDF of a certain range on a certain sheet. The purpose is to send the worksheet to others, so that they can then fill in the sheet and send the information that i want from them back to me by simply pressing a button.

I have made a working code for this using outlook, which is below. This works perfectly:

Sub EmailOrder()

sPath = Application.ActiveWorkbook.Path


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    strFileName = "\Order Request for xxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf"
Dim vShts As Variant
answer = MsgBox("The order will now save to your documents as a PDF. You don't need to keep this file after, we will still send you a copy of your invoice with your order.", vbOK, "")
        vShts = Sheets("Order").Range("M3")
        Select Case vShts
        Case 1
            Sheets("Order").Range("a1:k48").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 2
            Sheets("Order").Range("a1:k96").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 3
            Sheets("Order").Range("a1:k144").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 4
            Sheets("Order").Range("a1:k192").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
            End Select
    On Error Resume Next
    With OutMail
        .To = "sales@xxxxxxxxxx.co.uk"
        .CC = "me@xxxxxxxxxx.co.uk"
        .BCC = ""
        .Subject = "Order Request for xxxxxxxxxxx " & Now()
        .body = "Hello xxxxx," & vbNewLine & _
        " " & vbNewLine & _
              "Please could we order the consignment shown on the attached?" & vbNewLine & _
              "" & vbNewLine & _
             "Best regards,"                             'I would love a bit of code here to get the name of the person at a company from a given cell and add it on but not essential right now
        .attachments.Add sPath & "\" & strFileName
        .Display                        'Will be changed to .Send when i'm happy it works
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    Sheets("Prices").Select
End Sub

Like i say, this works fine but not everyone will be using Outlook, so i decided to make a button for gmail too. Then i realised it'd be much easier if these two buttons were just the one button, so i made a dummy email in gmail and plan to use this as the credentials in the below code, rather than ask for passwords etc. every time an order is sent. To my knowledge, this will then work on any computer with an internet connection and we will receive emails from the dummy gmail account into our sales email when the button is clicked. I have used the above working code with some Gmail code:

Sub SendEmailUsingGmail()


Dim NewMail As CDO.Message


Set NewMail = New CDO.Message


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxdummy@gmail.com"


NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxx"


NewMail.Configuration.Fields.Update


sPath = Application.ActiveWorkbook.Path
strFileName = "\Order Request for xxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf"
Dim vShts As Variant
answer = MsgBox("The order will now save to your documents as a PDF. You don't need to keep this file after, we will still send you a copy of your invoice with your order.", vbOK, "")
        vShts = Sheets("Order").Range("M3")
        Select Case vShts
        Case 1
            Sheets("Order").Range("a1:k48").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 2
            Sheets("Order").Range("a1:k96").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 3
            Sheets("Order").Range("a1:k144").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Case 4
            Sheets("Order").Range("a1:k192").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "\Order Request for xxxxxxxxx (Requested " & _
            Format(Now(), "dd mmm yy hh") & ").pdf", Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
            End Select


With NewMail
  .Subject = "Order Request for xxxxxxxxx " & Now()
  .From = "xxxxxxxxxdummy@gmail.com"
  .To = "sales@xxxxxxxx.co.uk"
  .CC = "me@xxxxxxx.co.uk"
  .BCC = ""
  .body = "Hello xxxxxxx," & vbNewLine & _
        " " & vbNewLine & _
              "Please could we order the consignment shown on the attached?" & vbNewLine & _
              "" & vbNewLine & _
             "Best regards"
.attachments.Add sPath & "\" & strFileName


End With


NewMail.Send
MsgBox ("Order has been Sent")


Set NewMail = Nothing


End Sub

When ran, i get a Compile error: User defined type not defined over 'Dim NewMail As CDO.Message' from the second line of the second code and i cant work out why. Googling it hasn't helped. Using excel 2013.

 

[John_w]

That Dim line is early binding and requires you to set a reference to Microsoft CDO 1.21 Library, via Tools > References in the VBA editor.

Alternatively, use late binding and declare NewMail as an object, like this:

    Dim NewMail As Object
    Set NewMail = CreateObject("CDO.Message")

 

[joshhargs]

That Dim line is early binding and requires you to set a reference to Microsoft CDO 1.21 Library, via Tools > References in the VBA editor.

Alternatively, use late binding and declare NewMail as an object, like this:

    Dim NewMail As Object
    Set NewMail = CreateObject("CDO.Message")

Hi John,

Thanks for your reply. That has fixed that error but as usual theres some run time errors to get through still on the attachment part. I've had enough for one day, i think i'll leave it for tomorrow. Thanks for your help!!