اضافه الى كود ارسال رسالة ل Gmail

Sub Send_Gmail_Using_CDO()

    Dim folder          As Variant

    Dim cdoMsg          As Object

    Dim file            As String

    Dim cdoNS           As String

    Dim htmlMsg         As String

    Dim password        As String

    Dim strBCC          As String

    Dim strCC           As String

    Dim strMsg          As String

    Dim strSubj         As String

    Dim strTo           As String

    Dim userEmail       As String

    Dim strBody         As String



    'الإيميل الذي سيرسل إليه

    strTo = "anyone@gmail.com"



    'عنوان الرسالة

    strSubj = "This Is The Subject Line"

    strMsg = ""

    strCC = ""

    strBCC = ""



    'مضمون الرسالة

    strBody = "Hello My Friend" & vbCrLf & "How Are You Doing?"



    'معلومات بريدك الاسم وكلمة السر

    userEmail = "my_gmail@gmail.com"

    password = "my_pass"



    Call ExportRangeToJpg

    file = ThisWorkbook.Path & "\Output.jpg"



    cdoNS = "http://schemas.microsoft.com/cdo/configuration/"

    Set cdoMsg = CreateObject("CDO.Message")



    With cdoMsg

        .To = strTo

        .Subject = strSubj

        .From = userEmail

        .CC = strCC

        .BCC = strBCC

        .TextBody = strBody

        .AddAttachment file

        .AddAttachment ThisWorkbook.Path & "\Sample.jpg"



        With .Configuration.Fields

            .Item(cdoNS & "smtpusessl") = True

            .Item(cdoNS & "smtpauthenticate") = 1

            .Item(cdoNS & "sendusername") = userEmail

            .Item(cdoNS & "sendpassword") = password

            .Item(cdoNS & "smtpserver") = "smtp.gmail.com"

            .Item(cdoNS & "sendusing") = 2

            .Item(cdoNS & "smtpserverport") = 465

            .Item(cdoNS & "smtpconnectiontimeout") = 60

            .Update

        End With



        .Send

    End With

    

    MsgBox "Sent", 64

End Sub



Private Sub ExportRangeToJpg()

    Dim objPic          As Shape

    Dim objChart        As Chart

    Dim rng             As Range

    Dim fname           As String



    Set rng = Sheets("Sheet2").Range("A1:G10")

    fname = "Output"



    Application.DisplayAlerts = False

        rng.CopyPicture xlScreen, xlPicture

        Sheets.Add , Sheets(Sheets.Count)

    

        With Sheets(Sheets.Count)

            .Shapes.AddChart

            .Activate

            .Shapes.Item(1).Select

            Set objChart = ActiveChart

            .Shapes.Item(1).Width = rng.Width

            .Shapes.Item(1).Height = rng.Height

            objChart.Paste

            objChart.Export (ThisWorkbook.Path & "\" & fname & ".jpg")

            .Delete

        End With

    Application.DisplayAlerts = True

End Sub