Outolook Mail gönderme sorunu

[acar6783]

Hayırlı günler.
Aşağıdaki kodlar ile mail gönderme işlemini sorunsuz yapıyorum fakat Outlooka baktığımda mailler gönderilmiş kutusunda yer alıyor fakat gönderdiğim mail adresine gitmiyor.
Hatta deneme amaçlı aynı maili gönderilen adrese ilet yaptım o gitti diğer deneme maillerim ulaşmadı.
Herhangi bir ayarı mı vardmır?

"Araçlar-GüvenMerkezi-Programlı erişim" e izin verdim ama bu sadece mail giderkenki uyarı ekranını kapatmak içindi

Option Explicit

Dim Yol As String
Dim Dosya_Adi As String
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim S1 As Worksheet, Onay As Byte

Sub PDF_KAYDET_MAIL_GONDER()
    Set Outlook_App = CreateObject("Outlook.Application")
    Set Outlook_Mail = Outlook_App.CreateItem(0)
    
    Set S1 = ActiveSheet
    
    Yol = ThisWorkbook.Path
    Dosya_Adi = Yol & "\" & "DenemeMail"
    ChDir Yol
        
    Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo, "Uyarı")
    
    If Onay = vbYes Then
        S1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Dosya_Adi, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
        With Outlook_Mail
            .To = "acar6783@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "Deneme Mailidir"
            .Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf _
            & "BA Mutabakat formu  ekte bilgilerinize sunulmuştur." & vbCrLf & vbCrLf & _
                    "Mutabık olduğunuza dair imzalı kaşeli görselini tarafımza göndermeniz rica olunur" _
                    & vbCrLf & "Saygılarımla" & vbCrLf & "İyi çalışmalar dileriM."
            .Attachments.Add Dosya_Adi & ".pdf"
            .BodyFormat = 2
            .Save
            .Send
            '.Display
        End With
        
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
    Else
        
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    
    End If
    
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
End Sub