Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1436to1440
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makros für PDF und Mac-Mail-Versand

Makros für PDF und Mac-Mail-Versand
17.07.2015 07:34:21
Fritz
Hallo,
ich hatte im web 2 makros gefunden, die mir (auf dem Mac) erlaubten eine excel Tabelle in ein PDF umzuwandeln und diese gleichzeitig mit dem (Mac)-Mail zu versenden.
Seit einiger Zeit funktioniert dies nicht mehr, obwohl Excel-seitig nichts verändert wurde?!
Nun frage ich mich, wo der Haken ist...
Hier mal die Makros, vielleicht kennt diese jemand, bzw. hat sie auch schon genutzt und weiss an was es liegt.
Danke für Eure Inputs!
Gruss, Fritz Müller
Option Explicit
'*****CODE EXAMPLES FOR MAC MAIL*********
Sub CreateMailPDFActiveWorkbookMacMail()
Dim TempPDFFolder As String
Dim PDFfolder As String
Dim PDFfileName As String
'Path to folder where we save the pdf's temporary. The code will create
'the folder named "PDFTempFolder" in your Documents folder for you
TempPDFFolder = MacScript("return (path to documents folder) as string") & "PDFTempFolder:"
'Folder where you want to save the PDF file, Documents folder in this example
PDFfolder = MacScript("return (path to documents folder) as string")
'Enter the file name that you want to use for the PDF, do not add the extension.
PDFfileName = "Menu Order"
'Do not change the macro calls below
Call MakePDF(TempPDFFolder, PDFfolder, PDFfileName, False)
Call DeleteFilesInPDFTempFolder(TempPDFFolder)
Call MakePDF(TempPDFFolder, PDFfolder, PDFfileName, True)
'Create and send E-mail if the PDF file exist
If FileExistsOnMac(PDFfolder & PDFfileName & ".pdf") = True Then
MailFromMacWithMail bodycontent:="", _
mailsubject:="", _
toaddress:="test@test.com", _
ccaddress:="", _
bccaddress:="", _
attachment:=PDFfolder & PDFfileName & ".pdf", _
displaymail:=False
'Delete the newly created file that you add to the mail
KillFileOnMac PDFfolder & PDFfileName & ".pdf"
End If
End Sub

und das 2. Makro:
Attribute VB_Name = "FunctionModule"
Option Explicit
'*********Functions used by the macros to create pdf files and create mails with the the pdf attached, do not change them**********
Function MakePDF(TempPDFLocation As String, YourPDFfolder As String, YourPDFName As String,  _
Finish As Boolean)
'

Function to create a PDF of the ActiveWorkbook in Excel 2011
'Note: The code will not work correct if not all sheets are the same type
'For example it will not work  if there is one chart sheet in the workbook
'If the sheets not all use landscape or portrait it is also not working correct
Dim I As Long
Dim SheetName As String
Dim scriptToRun As String
Dim ScriptToMakeDir As String
If ActiveWorkbook.Sheets.Count > 1 Then
'Script to create the Temporary PDF folder if it not exist
ScriptToMakeDir = "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
ScriptToMakeDir = ScriptToMakeDir & _
"do shell script ""mkdir -p "" & quoted form of posix path of " & _
Chr(34) & TempPDFLocation & Chr(34) & Chr(13)
ScriptToMakeDir = ScriptToMakeDir & "end tell"
On Error Resume Next
MacScript (ScriptToMakeDir)
On Error GoTo 0
Else
TempPDFLocation = YourPDFfolder
End If
'look for the first sheet name in the workbook
'We need this name so we can remove it from the file name
For I = 1 To ActiveWorkbook.Sheets.Count
If Sheets(I).Visible = True Then
SheetName = Sheets(I).Name
Exit For
End If
Next I
'Save the workbook as PDF, remove the sheet name from the file name(bug) and
'move the PDF to YourPDFfolder if the workbook have more then one worksheet.
scriptToRun = scriptToRun & "tell application " & Chr(34) & _
"Microsoft Excel" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & "save active workbook in (" & _
Chr(34) & TempPDFLocation & "TempName.pdf" & _
Chr(34) & ") as PDF file format" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
If Finish = True Then
scriptToRun = scriptToRun & "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & "set name of file " & Chr(34) & _
TempPDFLocation & "TempName " & SheetName & ".pdf" & Chr(34) & _
" to " & Chr(34) & YourPDFName & ".pdf" & Chr(34) & Chr(13)
If ActiveWorkbook.Sheets.Count > 1 Then
scriptToRun = scriptToRun & "move " & Chr(34) & TempPDFLocation _
& YourPDFName & ".pdf" & Chr(34) & " to " & Chr(34) & YourPDFfolder &   _
_
Chr(34) & Chr(13)
End If
scriptToRun = scriptToRun & "end tell" & Chr(13)
End If
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End Function
Sub DeleteFilesInPDFTempFolder(TempPDFFolder As String)
Dim scriptToRun As String
scriptToRun = scriptToRun & "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & _
"do shell script ""rm "" & quoted form of posix path of " & _
Chr(34) & TempPDFFolder & """ & " & Chr(34) & "*" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & "end tell"
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End Sub
Function KillFileOnMac(Filestr As String)
'The VBA Kill command on a Mac will not work with long file names(28+ characters)
Dim ScriptToKillFile As String
ScriptToKillFile = ScriptToKillFile & "tell application " & Chr(34) & _
"Finder" & Chr(34) & Chr(13)
ScriptToKillFile = ScriptToKillFile & _
"do shell script ""rm "" & quoted form of posix path of " & _
Chr(34) & Filestr & Chr(34) & Chr(13)
ScriptToKillFile = ScriptToKillFile & "end tell"
On Error Resume Next
MacScript (ScriptToKillFile)
On Error GoTo 0
End Function
Function FileExistsOnMac(Filestr As String) As Boolean
'No problem with long file names like the other examples(max of 27/28 characters)
Dim ScriptToCheckFile As String
ScriptToCheckFile = "tell application " & Chr(34) & "Finder" & Chr(34) & Chr(13)
ScriptToCheckFile = ScriptToCheckFile & "exists file " & Chr(34) & Filestr & Chr(34) & Chr(13)
ScriptToCheckFile = ScriptToCheckFile & "end tell" & Chr(13)
FileExistsOnMac = MacScript(ScriptToCheckFile)
End Function

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
toaddress As String, ccaddress As String, bccaddress As String, _
attachment As String, displaymail As Boolean)
Dim scriptToRun As String
scriptToRun = scriptToRun & "tell application " & _
Chr(34) & "Mail" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & _
"set NewMail to make new outgoing message with properties " & _
"{content:""" & bodycontent & """, subject:""" & _
mailsubject & """ , visible:true}" & Chr(13)
scriptToRun = scriptToRun & "tell NewMail" & Chr(13)
If toaddress  "" Then scriptToRun = scriptToRun & _
"make new to recipient at end of to recipients with properties " & _
"{address:""" & toaddress & """}" & Chr(13)
If ccaddress  "" Then scriptToRun = scriptToRun & _
"make new cc recipient at end of cc recipients with properties " & _
"{address:""" & ccaddress & """}" & Chr(13)
If bccaddress  "" Then scriptToRun = scriptToRun & _
"make new bcc recipient at end of bcc recipients with properties " & _
"{address:""" & bccaddress & """}" & Chr(13)
If attachment  "" Then
scriptToRun = scriptToRun & "tell content" & Chr(13)
scriptToRun = scriptToRun & "make new attachment with properties " & _
"{file name:""" & attachment & """ as alias} " & _
"at after the last paragraph" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
End If
If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
scriptToRun = scriptToRun & "end tell" & Chr(13)
scriptToRun = scriptToRun & "end tell"
If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
MsgBox "There is no To, CC or BCC address or Subject for this mail"
Exit Function
Else
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End If
End Function
Function MailFromMacwithOutlook(bodycontent As String, mailsubject As String, _
toaddress As String, ccaddress As String, bccaddress As String, _
attachment As String, displaymail As Boolean)
Dim scriptToRun As String
scriptToRun = scriptToRun & "tell application " & _
Chr(34) & "Microsoft Outlook" & Chr(34) & Chr(13)
scriptToRun = scriptToRun & _
"set NewMail to make new outgoing message with properties" & _
"{content:""" & bodycontent & """, subject:""" & mailsubject & """}" & Chr(13)
If toaddress  "" Then scriptToRun = scriptToRun & _
"make new to recipient at NewMail with properties" & _
"{email address:{address:""" & toaddress & """}}" & Chr(13)
If ccaddress  "" Then scriptToRun = scriptToRun & _
"make new cc recipient at NewMail with properties" & _
"{email address:{address:""" & ccaddress & """}}" & Chr(13)
If bccaddress  "" Then scriptToRun = scriptToRun & _
"make new bcc recipient at NewMail with properties" & _
"{email address:{address:""" & bccaddress & """}}" & Chr(13)
If attachment  "" Then
scriptToRun = scriptToRun & "make new attachment at NewMail with properties" & _
"{file:""" & attachment & """ as alias}" & Chr(13)
End If
If displaymail = False Then
scriptToRun = scriptToRun & "send NewMail" & Chr(13)
Else
scriptToRun = scriptToRun & "open NewMail" & Chr(13)
End If
scriptToRun = scriptToRun & "end tell" & Chr(13)
If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
MsgBox "There is no To, CC or BCC address or Subject for this mail"
Exit Function
Else
On Error Resume Next
MacScript (scriptToRun)
On Error GoTo 0
End If
End Function

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
und wo is dein MAC-Computer?
19.07.2015 16:48:25
Oberschlumpf
Hi Fritz
die Frage im Betreff is natürlich nich sooo ernst gemeint.
Aber es wäre vllt erfolgreicher, wenn du - anstelle von soooo viel Code - das Ganze per Upload hier in einer Bsp-Datei zur Verfügung stellst.
Geht das nicht, weil aufm Mac die Dateien nicht mit nem Win-PC geladen werden können oder hier im Upload-Bereich nich akzeptiert werden?
Dann pack deine Datei mit Code in eine ZIP-Datei.
Bin fast sicher, hier gibt es auch n paar Antworter, die auch mit nem Mac-PC arbeiten.
Ciao
Thorsten
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige