Úprava kódu pro odeslání emailu.

[luko02420]

Dobrý den, potřeboval bych poradit jak upravit tento kod, aby mi odesílal email automaticky pri zavření sesitu.
A dotaz, fungoval by kod po uprave i pro thunderbird, nebo je to jenom pro outlook?
Děkuji za pomoc.

Kód: Vybrat vše

Sub ExcelOutlookPriloha()
    '!!!!!Před použitím je třeba v Tools / References zaškrtnout volbu Microsoft Outlook xx.0 Object Library.!!!!!
    'Tools / References / Microsoft Outlook x.x Object Library

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim objNsp As Object
    Dim colSyc As Object
    Dim objSyc As Object
    Dim i As Integer
    Dim adresat As String
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Set objNsp = OutApp.Application.GetNamespace("MAPI")  'CORRECTION to Refer to the OutLook Application correctly
    Set colSyc = objNsp.SyncObjects
    
    adresat = "aaa@seznam.cz"
    
    With OutMail
   
        'adresát
        .To = adresat
        
        'kopie pro
        '.CC = "schranka@email.com"
       
        'skrytá kopie pro
        '.BCC = "eee@gggg.cz"
       
        'předmět zprávy
        .Subject = "Dodací list (e)"
       
        'text zprávy a určení buňky
        .Body = "Dobrý den, , zasílám Vám dodací list číslo:  " & ActiveSheet.Range("D3") & Chr(13) & Chr(13) & "S pozdravem" & Chr(13) & Chr(13) & "bb" & Chr(13) & "vedoucí b" & Chr(13) & "b" & Chr(13) & "b5" & Chr(13) & "b" & Chr(13) & "mob: b b" & Chr(13) & "email: b"
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add ActiveWorkbook.FullName
        
        'Nastavení preferovaného účtu pro odeslání pošty - v tomto případě druhý v pořadí
        'Dostupné od verze Office 2007
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)

        'jiná příloha
        '.Attachments.Add ActiveWorkbook.Path & "\soubor.txt"
       
        'zobrazení okna se zprávou (není nutné)
        '.Display
       
        'odeslání zprávy
        .Send
       
    End With
     
    For i = 1 To colSyc.Count
        Set objSyc = colSyc.Item(i)
        objSyc.Start
    Next

    'OutApp.Quit
    MsgBox "Zpráva byla odeslána na adresu: " & adresat, vbInformation
    'uvolnění z paměti
    Set OutMail = Nothing
    Set objNsp = Nothing
    Set colSyc = Nothing
    Set objSyc = Nothing
    Set OutApp = Nothing
   
End Sub

[guest]

Událostní procedura Workbook_BeforeClose.
Pokud vím, Thundebird nenabízí objektový model k dispozici, maximálně ještě CDO, když ne Outlook.

[luko02420]

Použil jsem tento kod, dotaz me naskocí ale kdyz odpovim ne, tak se mi sesit zavre. nevim co mam spatně.
Dík za pomoc.

Kód: Vybrat vše

Private Sub WorkBook_BeforeClose(Cancel As Boolean)
dotaz = "Odeslal jsi email?"
odpoved = MsgBox(dotaz, vbYesNo, "Ukončení práce...!")
If odpoved = vbNe Then Cancel = True
End Sub

[guest]

vbNo

[luko02420]

Děkuji
Jeste prosba, jak mam doplnit kod na odeslani emailu, aby mi treba do bunky D5 vlozil udaj kdy byl email odeslán.
Jeste jednou dekuji.

[guest]

Range("D5").Value=...

... Date, Now, něco...

[luko02420]

Děkuji