Úprava kodu pro odeslání pdf.
Napsal: 05 zář 2018 07:48
Dobrý den, potreboval bych poradit jak upravit kod aby mi jako priloha odesílal sobor ve formatu pdf. Nemuzu na to prijit.
Tak jak to mam ted tak vse funguje, ale chtel bych odesilat prave pdf. Prosim neukamenujte me za ten ruzne poskladaný kod. V kodu sice je jina příloha nez je sesit excelu ale nemuzu prijit na to jak pdf nacist do prilohy.Dekuji vsem.
Tak jak to mam ted tak vse funguje, ale chtel bych odesilat prave pdf. Prosim neukamenujte me za ten ruzne poskladaný kod. V kodu sice je jina příloha nez je sesit excelu ale nemuzu prijit na to jak pdf nacist do prilohy.Dekuji vsem.
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
Range("C39").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("C39").Select
Selection.NumberFormat = "d/m/yy h:mm;@"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("L24").Select
Range("D37").Value = ""
Range("D38").Value = ""
' Uložení souboru
jmeno = Range("L1") 'Jméno
jmeno1 = Range("C35") 'Datum jako jmeno souboru
jmeno2 = Range("M2") 'přípona souboru
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"I:\\" & jmeno1 & (" " & jmeno & jmeno2), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "" & jmeno
'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 = ""
With OutMail
'adresát
.To = adresat
'kopie pro
'.CC = "schranka@email.com"
'skrytá kopie pro
'.BCC = ""
'předmět zprávy
.Subject = ""
'text zprávy a určení buňky
'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.pdf"
'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