Makros für PDF und Mac-Mail-Versand

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makros für PDF und Mac-Mail-Versand
von: Fritz
Geschrieben am: 17.07.2015 07:34:21

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

Bild

Betrifft: und wo is dein MAC-Computer??
von: Oberschlumpf
Geschrieben am: 19.07.2015 16:48:25
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makros für PDF und Mac-Mail-Versand"