Macro Excel bestand opslaan als PDF en bijvoegen als email

[BramW]

Goedemiddag,

Ik ben op zoek naar een macro voor twee handelingen in één, te weten:

1: Opslaan als PDF met als naam een uniek nummer (op basis van bijvoorbeeld de datum en tijd)
2: Bijvoegen als bijlage in E-mail van Outlook

De tweede stap is me reeds gelukt, de eerste echter niet (zie het bijgevoegde bestand). Ik hoop dat jullie me verder kunnen helpen!

Vriendelijke groet en alvast bedankt voor de moeite,

BramBekijk bijlage 131223 Mutatieformulier overig werkversie.xls

Edit: Wachtwoord = Acc123

 

[johhnnyboy]

Twee functies

Hoi,

Zelf gebruik ik twee functies ooit gevonden op internet. Moet je zelf mogelijk aanpassen:

Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    
    Dim FileFormatstr As String
    Dim Fname As Variant

    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, Title:="Opslaan PDF")

            If Fname = False Then
            
                Exit Function
                
            End If
            
        Else
        
            Fname = FixedFilePathName
            
        End If

        If OverwriteIfFileExist = False Then
        
            If Dir(Fname) <> "" Then
            
                Exit Function
                
            End If
                
        End If

        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        If Dir(Fname) <> "" Then
        
            RDB_Create_PDF = Fname
        End If
        
    End If
    
End Function

En

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, StrSubject As String, StrBody As String, Send As Boolean)
    
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        
            If Send = True Then
                .Send
            Else
                .Display
            End If
            
    End With
    
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Function

Denk dat als je op de functienamen googled je mogelijk de originele poster kunt achterhalen

 

[BramW]

Hoi Johhnnyboy,

Bedankt voor je reactie, super!

Ik ga er mee aan de slag