Otomatik Mail Giden Kutusunda Bekliyor

[vivident]

Merhaba

Excelden belirlediğim kişilere otomatik mail gönderiyorum. Outlook açıksa eğer mail hemen gidiyor. Outlook kapalı ise mailim "giden kutusunda" bekliyor ve Outlook'u açınca mail gönderiliyor.

Ben Outlook kapalı olsa bile mailimin karşı tarafıma gitmesini istiyorum. Kodlarım aşağıdaki gibidir

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
                                              ByVal bScan As Byte, _
                                              ByVal dwFlags As Long, _
                                              ByVal dwExtraInfo As Long) 'e-mail icin
Private Type evn 'e-mail için
    x As Long
    Y As Long
End Type

Private evnMenum As Long 'e-mail için
Const evnSol = &H0&
Const evnGeri = &H100&
Const evnSag = &H2&

Private Const VK_LMENU = &HA4 'e-mail için
Private Const VK_SNAPSHOT = &H2C 'e-mail için
Private Const VK_CONTROL = &H11 'e-mail için
Private Const VK_V = &H56 'e-mail için
Private Const VK_0x79 = &H79 'e-mail için
Private Const KEYEVENTF_EXTENDEDKEY = &H1 'e-mail için
Private Const KEYEVENTF_KEYUP = &H2 'e-mail için

Private Sub Otomatikmail() 'e-mail kodları
    sAppOs = Application.OperatingSystem
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If Mid(sAppOs, 18, 2) = "NT" Then
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
        Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    Else
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
        Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
    End If
    DoEvents
    Set kitap = Workbooks.Add.Sheets(1)
    Application.Goto kitap.Range("A1")
    ActiveSheet.Paste
    kitap.SaveAs Filename:="C:\TR_BUR_DFCM\Fiabmail\mail.htm", FileFormat:=xlHtml
    kitap.Parent.Close False
    Kill ("C:\TR_BUR_DFCM\Fiabmail\mail.htm")
    Kill ("C:\TR_BUR_DFCM\Fiabmail\mail_dosyalar\filelist.xml")
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Yükleme İşlemi Başarı ile Tamamlandı", vbInformation, "Merhaba Dosyası"
    Unload Me
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    'OutApp.Session.Logon Hangi mail tipi ile göndereyim diye soruyor Outlook...vs
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = TextBox11.Text
        .CC = ""
        .BCC = ""
        .Subject = "Merhaba"
        .Body = "Adınıza Ait ; Merhaba Dosyasına Problem Girişi Yapılmıştır. Problem İle İlgili Fotoğraf Ektedir"
        .Attachments.Add "C:\TR_BUR_DFCM\mail_dosyalar\image002.png"
        .Display
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[Korhan Ayhan]

".Display" komutu maili göndermeden önce görüntülemek için kullanılır. Siz direkt göndermek istediğiniz için sadece ".Send" satırını kullanmalısınız.