Link to home
Start Free TrialLog in
Avatar of Murray Brown
Murray BrownFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Excel Receiving emails straight off the internet

Hi

I was given the following  VBA code to send mail from Excel without using my Outlook.
I want to find similar code to process incoming mail using CDO. Thanks

Sub A()
    Call CDO_Mail_Small_Text_3("Johannesburg")
End Sub



Sub CDO_Mail_Small_Text_3(Location As String)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String

    On Error GoTo SendingFailed

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

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    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") = "doppiosending@gmail.com"
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "d0pp10sending"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "murbro9@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    
    'Adding In
    
    'If Val(Application.Version) >= 12 Then
    '    If wb.FileFormat = 51 And wb.HasVBProject = True Then
    '        MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
    '               "Save the file first as xlsm and then try the macro again.", vbInformation
    '        Exit Sub
    '    End If
    'End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    
    strbody = "From Doppio" & vbNewLine & vbNewLine & _
              Location

    With iMsg
        Set .Configuration = iConf
        .To = "admin@macros-vba.com"
        '.CC = "nomusa@excelintegration.co.za"
        '.BCC = "davidt@excelintegration.co.za"
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Murray"" <murbro9@gmail.com>"
        .Subject = "Doppio Cashup" & Date
        .TextBody = strbody
        '.AddAttachment Location
        .Send
    End With
    
    'If you not want to delete the file you send delete this line

    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Exit Sub
SendingFailed:
    MsgBox ("Email Could not send")
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of sdwalker
sdwalker
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Murray Brown

ASKER

Thanks very much