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