No Outlook: Excel Sending mail with CDO.

[countryfan_nt]

Hello friends, Hope all is well!

The code below does work. it sends a sheet as PDF via Outlook.
Please help me edit the code, so that it sends a sheet as PDF withOUT Outlook; but CDO.

Your kind is needed and really appreciated in advance!

Private Sub Email()
    
    Set OutApp = GetObject(, "Outlook.Application")
    Dim IsCreated As Boolean
    Dim i As Long
    Dim ab, ac, ad, emTo, emCC As String
    Dim PdfFile As String, Title As String
    Dim OutlApp As Object
    
    emTo = Worksheets("PDF").Range("BD4").Value
    emCC = Worksheets("PDF").Range("BD5").Value
    ab = Worksheets("PDF").Range("B1").Value
    GREET = Worksheets("PDF").Range("AZ4").Value
    AMPM = Worksheets("PDF").Range("AZ6").Value
    
    Set xSht = ThisWorkbook.Sheets("PDF")
   
   
   Title = AMPM & " - " & Sheets("PDF").Range("G1")
    TitleF = AMPM & " Period Update - " & Format(ab, "ddd dd-mmm-yyyy") & " - Medical Gas Inspection Summary."
    
    PdfFile = ActiveWorkbook.FullName
    i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = AMPM & " Period Update - " & Format(ab, "ddd dd-mmm-yyyy") & " - Medical Gas Inspection Summary" & ".pdf"
    
    
     Sheets("PDF").Visible = True
     
    xSht.ExportAsFixedFormat Type:=xlTypePDF, _
                                       Filename:=PdfFile, _
                                       Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, _
                                       IgnorePrintAreas:=False, _
                                       OpenAfterPublish:=False
     
    On Error Resume Next
    Set OutlApp = GetObject(, "Outlook.Application")
    
    If Err Then
        Set OutlApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If
    
    OutlApp.Visible = True
    On Error GoTo 0
    
    With OutlApp.CreateItem(0)
        ' Prepare e-mail
        .Subject = TitleF
        .to = emTo ' <-- Put email of the recipient here
        .CC = emCC ' <-- Put email of 'copy to' recipient here
        .HTMLBody = GREET & vbLf & vbLf _
                    & "<p> The attachment here displays the findings of the inspections of all the medical gasses (per location & Branch)." & vbLf _
                    & "<p> Whethere the they were actually inspected or not, and what what are the results are after a physical visit." & vbLf _
                    & "<p><i>Two emails will be sent on daily basis (weekends not included)</i>" & vbLf & vbLf _
                    & "<p><p>Best Regards,<br>" & vbLf _
                    & " " & vbLf & vbLf
                    .Attachments.Add PdfFile
        ' Try to send
        On Error Resume Next
        Set .SendUsingAccount = OutlApp.Session.Accounts.Item(1)   'Use 2nd Account in the  list
         
        .DISPLAY
        Application.Wait (Now + TimeValue("0:00:01"))
        Application.SendKeys "%s"
         
        Application.Visible = True
        
        On Error GoTo 0
    End With
    
    ' Delete PDF file
    Kill PdfFile
    
    ' Quit Outlook if it was created by this code
    If IsCreated Then OutlApp.Quit
    
    ' Release the memory of object variable
    Set OutlApp = Nothing
    
Sheets("PDF").Visible = False
End Sub

 

[countryfan_nt]

Hello! OK I figured something out, but got stuck again. please help me fix the following bug:
Run time error 13: Type Mismatch

The highlighted line is: .Attachments.Add PdfFile

Thank you very much in advance!

Sub SendMail()
Dim filepath As String
 'TODO:change filepath for the temp pdf file
 'Exporting range of the excel contents which need to sent out
 Dim PdfFile As String, Title As String
 Dim IsCreated As Boolean
 Dim i As Long
 Dim ab, ac, ad, emTo, emCC As String
    
    
    emTo = Worksheets("PDF").Range("BD4").Value
    emCC = Worksheets("PDF").Range("BD5").Value
    ab = Worksheets("PDF").Range("B1").Value
    GREET = Worksheets("PDF").Range("AZ4").Value
    AMPM = Worksheets("PDF").Range("AZ6").Value
 
    
    Set xSht = ThisWorkbook.Sheets("PDF")
   
' Hide all sheets except PDF
'Sheets(Array("Khobar", "Qassim", "Takhassusi", "SWD", "RayyanMainBldg", "RayyanIVFRoom1Room2", "OlayaOSSHB1HMC3", "OlayaMatB1IVFB1")).Visible = False
   
    ' Not sure for what the Title is
   Title = AMPM & " - " & Sheets("PDF").Range("G1")
    TitleF = AMPM & " Period Update - " & Format(ab, "ddd dd-mmm-yyyy") & " - Medical Gas Inspection Summary."
    
    ' Title & " - " & ab
    ' Define PDF filename
    PdfFile = ActiveWorkbook.FullName
    i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = AMPM & " Period Update - " & Format(ab, "ddd dd-mmm-yyyy") & " - Medical Gas Inspection Summary" & ".pdf"
    
   ' PdfFile
   ' Export activesheet as PDF
    
     Sheets("PDF").Visible = True
     
    xSht.ExportAsFixedFormat Type:=xlTypePDF, _
                                       Filename:=PdfFile, _
                                       Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, _
                                       IgnorePrintAreas:=False, _
                                       OpenAfterPublish:=False
     
    
 'Setting up CDOSYS configuration to send out the email
Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'send via port
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "ServerName" 'TODO:update the SMTP server name here
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
 
    With iMsg
         Set .Configuration = iConf
        .From = "nwf@domain.com" 'TODO:change email address here
        .To = emTo  'TODO:change email address here
        .cc = emCC  'TODO:change email address here
                
        .Subject = TitleF
        
                   .HTMLBody = GREET & vbLf & vbLf _
                    & "<p> The attachment here displays the findings of the inspections of all the medical gasses (per location & Branch)." & vbLf _
                    & "<p> Whethere the they were actually inspected or not, and what what are the results are after a physical visit." & vbLf _
                    & "<p><i>Two emails will be sent on daily basis (weekends not included)</i>" & vbLf & vbLf _
                    & "<p><p>Best Regards,<br>" & vbLf _
                    & " " & vbLf & vbLf
        
            
'     .AddAttachment PdfFile
     'PdfFile
       .Attachments.Add PdfFile
        
        
        .DISPLAY
        Application.Wait (Now + TimeValue("0:00:01"))
        Application.SendKeys "%s"
         
        Application.Visible = True
        
              
    End With
 
    Set iMsg = Nothing
    Set iConf = Nothing
End Sub