Hallo Balu,
in dem unten aufgeführtem Makro, wird jetzt folgendes erreicht das Tabellenblatt
wird als pdf exportiert und abgespeichert. Bitte nicht auf die Programmierung schauen.
Danach öffnet das Makro "MS Outlook" und trägt alles ein. Jetzt fehlt nur noch, dass er
die abgespeicherte pdf einfügt. Ich weiß leider nicht, wo und wie ich den Befehl mit
attachment eintragen muß.
Kann mir jemand helfen?
Gruß Defe
Code: Alles auswählen
Sub BestellungSpeichernUndVersenden
REM Definition der Variablen
Dim document as Object
Dim dispatcher as Object
Dim stringname as String
Dim PDFempfText as String
Dim ODScalc as Object
Dim strAttPfad As String
Calc = ThisComponent
Sheet = Calc.Sheets(0)
REM Empfängername finden
CCCell = Sheet.GetCellRangeByName("B11")
PDFempfString = CCCell.String
REM Dokumentenzugriff
document = ThisComponent.CurrentController.Frame
dispatcher = CreateUnoService("com.sun.star.frame.DispatchHelper")
REM Wenn Bestellung 1-seitig
If ZStringName = "0" then
REM Druckbereich für 1 Seite
dim args10(1) as new com.sun.star.beans.PropertyValue
args10(0).Name = "ToPoint"
args10(0).Value = "$A$1:$J$61"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())
REM PDF-Export
dim args11(1) as new com.sun.star.beans.PropertyValue
args11(0).Name = "URL"
args11(0).Value = "file:///O:/Dokumente/Kalenderbestellung." & stringname & ".pdf"
args11(1).Name = "FilterName"
args11(1).Value = "calc_pdf_Export"
dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args11())
REM Druckbereich entfernen
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array()
Else
REM Druckbereich für 2 Seiten
dim args20(1) as new com.sun.star.beans.PropertyValue
args20(0).Name = "ToPoint"
args20(0).Value = "$A$1:$J$61"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args20())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())
dim args21(1) as new com.sun.star.beans.PropertyValue
args21(0).Name = "Nr"
args21(0).Value = 2
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args21())
dim args22(1) as new com.sun.star.beans.PropertyValue
args22(0).Name = "ToPoint"
args22(0).Value = "$A$1:$J$61"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args22())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())
REM PDF-Export
Datei = "file:///O:/Dokumente/" & stringname & ".pdf"
dim pdfproperties(1) as new com.sun.star.beans.PropertyValue
pdfproperties(1).Name = "FilterName"
pdfproperties(1).Value = "calc_pdf_Export"
ThisComponent.StoreToUrl( Datei, pdfproperties())
StrAttPfad = ThisComponent.GetUrl ("file:///O:/Dokumente" & stringname & ".pdf")
REM Druckbereiche entfernen
dim args23(1) as new com.sun.star.beans.PropertyValue
args23(0).Name = "ToPoint"
args23(0).Value = "$A$1:$J$61"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args23())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array())
dim args24(1) as new com.sun.star.beans.PropertyValue
args24(0).Name = "Nr"
args24(0).Value = 2
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args24())
dim args25(1) as new com.sun.star.beans.PropertyValue
args25(0).Name = "ToPoint"
args25(0).Value = "$A$1:$J$61"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args25())
dispatcher.executeDispatch(document, ".uno:DeletePrintArea", "", 0, Array())
End If
REM ODS-Datei speichern
ODScalc = ThisComponent
ODScalc.Store()
REM Messagebox
PDFempfText = "Die " & stringname & "" & PDFempfString
msgbox PDFempftext & " wurde erfolgreich gespeichert und steht zum versenden bereit!", 64, "Herzlichen Glückwunsch!"
REM gespeicherte PDF senden
Dim strAn As String
Dim strBetr As String
Dim strBody As String
Dim strShell As String
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
.Subject = "Kalenderbestellung 2018"
.Body = "Hallo Herr Reinke, " & Chr(13) & _
"" & Chr(13) & _
"anbei erhalten Sie meine Kalenderjahresbestellung 2018." & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & _
"Viele Grüße " & Chr(13) & _
""
.To = "reinke@test.de"
End With
With Application.ActivePrinter
End With
Mail.Display
Set Mail = Nothing
Set outObj = Nothing
End Sub