Salvare foglio excel in pdf e imviarlo per email

Function SendEmail()
    
    Dim CDO_Mail_Object As Object
    Dim CDO_Config As Object
    Dim SMTP_Config As Variant
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim mPath As String
    Dim Testo As String
    Dim Email_Body As String
    
    Const mSender As String = "XXXXXXXXX@asp.città.it" ' variare
    Const FileDaInviare As String = "Allegato.pdf"
    Const mUsing As Byte = 2
    Const mServer As String = "kosservizi.com"
    Const mPort As Integer = 465
    Const mAutenticate = 1
    Const mSSL = False
    Const mTime As Integer = 60
    Const mPsw As String = "TuaPassword" ' variare
    
    myPath = ActiveWorkbook.Path & "\"
    
    'disabilita eventi
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    
    'setta i parametri del CDO(Collaboration Data Objects)
    Set CDO_Mail_Object = CreateObject("CDO.Message")
    On Error GoTo errori
    Set CDO_Config = CreateObject("CDO.Configuration")
    CDO_Config.Load -1
    Set SMTP_Config = CDO_Config.Fields
    With SMTP_Config
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = mUsing
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServer
        .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = mPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = mAutenticate
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = mTime
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mSender
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mPsw
        .Update
    End With
    
    'valorizza Mittente, oggetto e Corpo della mail
    Email_Send_From = mSender
    
    Email_Subject = "Oggetto dell'email" 'variare
    
    Email_Body = "In allegato....." & vbCrLf & _
                 "Authomatic Email, please do not answer!!"
    
    'assegna i vari parametri della mail
    With CDO_Mail_Object
    Set .Configuration = CDO_Config
    End With
    CDO_Mail_Object.From = Email_Send_From
    CDO_Mail_Object.Subject = Email_Subject
    CDO_Mail_Object.TextBody = Email_Body
    CDO_Mail_Object.AddAttachment myPath & FileDaInviare
    
        CDO_Mail_Object.To = "Indirizzo Destinatario" ' variare
        CDO_Mail_Object.Send
        Application.Wait (Now + TimeValue("0:00:01")) '<<<<<<<<<<<<<<<<<<<<<<
    MsgBox "Email sent"

xit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    Set CDO_Mail_Object = Nothing
    Set SMTP_Config = Nothing
    
    Exit Function
errori:
    If Err.Description <> "" Then
        MsgBox "Qualcosa è andata male. " & Err.Number & "-" & Err.Description
    End If
    Resume xit
End Function

ThisWorkbook.VBProject.References _
 .AddFromGuid "{CD000000-8B95-11D1-82DB-00C04FB1625D}", Major:=1, Minor:=0

Sub ListVbaReference()
Dim mVBA As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim mRefer As Reference
Dim r As Integer
Cells.ClearContents ' <<<<<< OCCHIO!!!!!
Set mVBA = Application.VBE
Set vbProj = ActiveWorkbook.VBProject

Cells(1, 1) = "Nome"
Cells(1, 2) = "Descrizione"
Cells(1, 3) = "Percorso"
Cells(1, 4) = "GUID"
r = 2
For Each mRefer In vbProj.References
    Cells(r, 1) = mRefer.Name
    Cells(r, 2) = mRefer.Description
    Cells(r, 3) = mRefer.FullPath
    Cells(r, 4) = mRefer.GUID
    r = r + 1
Next
Set vbProj = Nothing
Set mVBA = Nothing
End Sub