Private Sub CommandButton1_Click()
Dim dosyaAdLogo As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim ek_Ekle As Object
Dim yol As String
Dim son As Long
Dim ek As String
Dim x As Long

x = 2
If outlookAcikmi = True Then
    MsgBox "Outlook kapat ve tekrar calistir..", vbCritical, "Hata"
    Exit Sub
End If

With ThisWorkbook.Sheets("Sayfa1")
    Do While .Cells(x, 1).Value <> ""
        Set outlookapp = CreateObject("Outlook.Application")
        Set outlookmailitem = outlookapp.createitem(0)
        Set ek_Ekle = outlookmailitem.Attachments
        yol = ThisWorkbook.path & Application.PathSeparator
        dosyaAdLogo = "Bayrak.png"
        ek = yol & .Cells(x, 3).Value
        
        outlookmailitem.To = .Cells(x, 1).Value
        outlookmailitem.Subject = .Cells(x, 2).Value
        outlookmailitem.Attachments.Add yol & dosyaAdLogo, 0
        
        outlookmailitem.HTMLBody = _
            "Sayin  " & .Cells(x, 4).Value & "<br>" _
            & "<br> xxxxxxx<br>" _
            & "<br> yyyyyyy <br> " _
            & "<br> zzzzzzz<br><br><br>" _
            & " <br> <img src='" & dosyaAdLogo & "'" & "width='150' height='100'> "
                
        ek_Ekle.Add (ek)
        outlookmailitem.display
        Application.Wait (Now + TimeSerial(0, 0, 3))
    '        outlookmailitem.send
        Application.Wait (Now + TimeSerial(0, 0, 3))
        son = son + 1
        adres = vbNullString
        x = x + 1
        Set outlookapp = Nothing
        Set outlookmailitem = Nothing
    Loop
End With
OutlookAc
End Sub

Public Sub OutlookAc()
    Dim ws As Object
    Dim sPath As String
    Set ws = CreateObject("WScript.Shell")
    sPath = ws.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\OUTLOOK.EXE\")
    Set ws = Nothing
    Call Shell(sPath)
End Sub

Function outlookAcikmi() As Boolean
    Dim objOutlook As Object
    outlookAcikmi = False
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Not objOutlook Is Nothing Then
        outlookAcikmi = True
    End If
    On Error GoTo 0
    Set objOutlook = Nothing
End Function