vba da outlok ıle maıl gonderımınde hata

Katılım
16 Mayıs 2007
Mesajlar
5
Excel Vers. ve Dili
Türkçe
Merhaba
Sayfam da asagıdakı kodlar ıle eposta gonderıyorum. Fakat eposta gitmeden outlok uygulamasını kapattıgı ıcın maıl gitmıyor. kodlar da outlok uygulamasını sımge durumunda kuculterek uygulamadan cıkış yapmamasını nasıl saglarım.

Kod:
Private Sub CommandButton8_Click()

Dim OutApp As Object, Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
Outmail.BodyFormat = 2
With Outmail
.To = "aaaaaa@hotmail.com"
.CC = ""
.Subject = "DENEME"
dosya = Worksheets("veri").Range("G3").Value & ".txt"

.Attachments.Add (Environ("USERPROFILE") & "\Desktop\" & "\" & dosya)
'Not: Dosya yolunu yazdıktan sonra tırnak işaretlerini kaldırın
.Display
.Send 'Göndermek için .send den önceki ' tek tırnak işaretini kaldırın
End With
Set Outmail = Nothing: Set OutApp = Nothing

End Sub
 

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
1,072
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod:
Private Sub CommandButton8_Click()

    Dim OutApp As Object, OutMail As Object
    Dim ns As Object, exp As Object
    Dim dosya As String, fpath As String
    Dim so As Object

    On Error GoTo CleanFail
   
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OutApp Is Nothing Then
        Set OutApp = CreateObject("Outlook.Application")
    End If

    Set ns = OutApp.GetNamespace("MAPI")  
    ns.Logon "", "", False, False
   
    If OutApp.Explorers.Count = 0 Then
        ' 6 = olFolderInbox, 0 = olFolderDisplayNormal
        Set exp = OutApp.Explorers.Add(ns.GetDefaultFolder(6), 0)
        exp.Display
        exp.WindowState = 1  ' 1 = olMinimized
    Else
        OutApp.ActiveExplorer.WindowState = 1  
    End If
   
    Set OutMail = OutApp.CreateItem(0)

    dosya = Worksheets("veri").Range("G3").Value & ".txt"
    fpath = Environ$("USERPROFILE") & "\Desktop\" & dosya  

    With OutMail
        .To = "aaaaaa@hotmail.com"
        .CC = ""
        .Subject = "DENEME"
        .BodyFormat = 2   ' 2 = olFormatHTML
        .HTMLBody = "Merhaba,<br><br>Deneme e-postası.<br><br>Saygılar."
        If Len(Dir$(fpath)) > 0 Then
            .Attachments.Add fpath
        Else
            MsgBox "Ek dosya bulunamadı: " & fpath, vbExclamation
        End If
        '.Display        
        .Send            
    End With
   
    On Error Resume Next
    For Each so In ns.SyncObjects
        so.Start
    Next
    On Error GoTo 0

CleanExit:
    Set OutMail = Nothing
    Set exp = Nothing
    Set ns = Nothing
    Set OutApp = Nothing
    Exit Sub

CleanFail:
    MsgBox "E-posta gönderilirken hata oluştu: " & Err.Description, vbExclamation
    Resume CleanExit
End Sub
Bu haliyle Outlook arka planda açık kalır ve e-postanız çıkış yapmadan gönderilir.
 
Üst