VBA - wysyłanie maila z załącznikiem przez thunderbirda

Question

Cześć, Mam taki kod który działał u mnie dłuższy czas ale zmieniłem program pocztowy z Outlooka na thunderbirda i nie mogę tego przerobić. A działa on tak że z Excela generuje się pdf który jest zapisywany w danym katalogu a następnie załączany jest do wiadomości jako załącznik. Ktoś ma pomysł jak to zrobić na thunderbirda ?

 

Sub doPDF()

Dim pdfFileName As String
Dim pdfSaveDir As String
Dim pdfSaveDirYear As String
Dim pdfFile As String
Dim miesiac As String
Dim rok As String

Dim strDir As String
Dim iRet As Integer




ActiveSheet.Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$F$110"
ActiveSheet.PageSetup.Orientation = xlPortrait ' Orientacja strony

If ActiveSheet.Range("b3") <> "" Then
ActiveSheet.Name = Left(ActiveSheet.Range("b3"), 3)
End If

' Pobranie z systemu aktualnego miesiąca i roku
miesiac = Month(Now)
rok = Year(Now)


' Ustalenie ścieżek zapisu pliku
pdfSaveDirYear = "C:\raport\" + rok + "\"
pdfSaveDir = "C:\raport\" + rok + "\" + miesiac + "\"
pdfFileName = "Raport" & Date & "_" & [numer].Value

pdfFile = pdfSaveDir + pdfFileName + ".pdf"
 'MsgBox pdfFile

' Sprawdzenie czy na dysku są katalogi, jeśli nie to tworzymy je
    strDir = pdfSaveDirYear
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        'MsgBox "Directory year exists."
        strDir = ""
    End If
    
    strDir = pdfSaveDir
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
        'MsgBox "Directory month exists."
    End If


'Eksport do PDF

With ActiveSheet
    On Error Resume Next
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\" + pdfFile, Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
End With



 'Tworzenie maila z odbiorcami, tytułem oraz załącznikiem
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = "test@test.pl"
        .CC = "test@test.pl; test@test.pl"
        .Subject = pdfFileName
        '.Body = "..."'
        .HTMLBody = "treść wiadomości" & .HTMLBody
        .Attachments.Add pdfFile
        If DisplayEmail = False Then
            '.Send
        End If
 
End With

End Sub

 

Comments

Sprawdź to:  VBA - Send E-mail Using Mozilla Thunderbird