Snasui Excel Forum

Code: Select all

Sub SendEmailUsingOutlook()

    Dim myEmail As Outlook.Application
    Dim Item As Outlook.MailItem
    
    Set myEmail = New Outlook.Application
        EndRow = Sheets("Detail_Send_Mail").Range("B" & Rows.Count).End(xlUp).Row
        
        For i = 2 To EndRow
        Set Item = myEmail.CreateItem(olMailItem)
        With Item
            .To = Sheets("Detail_Send_Mail").Range("B" & i).Value
            .Subject = Sheets("Detail_Send_Mail").Range("C" & i).Value
            .Attachments.Add (Sheets("Detail_Send_Mail").Range("E" & i).Value)
            .Body = Sheets("Detail_Send_Mail").Range("F" & i).Value
            .Send
        End With
    
    Next i
    MsgBox "Done"
    
End Sub

Code: Select all

'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail()
    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String
    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 = "youremail@gmail.com"
        .To = "recipient@domain.com"
        .CC = ""
        .BCC = ""
        .Subject = "Demo Spreadsheet Attached"
        .Textbody = "Let me know if you have questions about the attached spreadsheet!"
        .Addattachment "c:\data\testmail.xlsx"
    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") = "youremail@gmail.com" 'Your gmail address
        .Item(msConfigURL & "/sendpassword") = "yourpassword" 'Your password or App Password
        .Update                                               'Update the configuration fields
    End With
    NewMail.Configuration = mailConfig
    NewMail.Send
    
    MsgBox "Your 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

Code: Select all

'Other code
For i = 2 To EndRow
'Other code
Next i
'Other code