Mailen

  • Onderwerp starter Onderwerp starter Roma
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
R

Roma

Gebruiker
Lid geworden
7 sep 2013
Berichten
515
beste mensen,

ooit heb ik een code gekregen om een PDF te maken (zie bijlage) van een bepaalde range.
Nu wil ik deze PDF file graag met de mail versturen. Helaas lukt het mij niet. Ook heb ik gekeken op de site van Ron de Bruin.
Wie kan mij een oplossing aandragen.
Alvast bedankt
 
Dus je hebt dit bestandje van Ron gedownload, en krijgt de code niet werkend? Want ik zie die procedure niet terug in jouw voorbeeld.
 
Beste Michel,
Mijn bestand heb ik NIET van Ron gedownload.
Ik heb gekeken op de site van Ron en ik weet de procedure niet om outlook aan te roepen.
 
Ik zei ook niet dat jouw bestand van Ron was :). Maar in het bestand dat hij aanbiedt staat een compleet werkende code, die je vrij makkelijk zou moeten kunnen plakken. Dan krijg je iets als:

Code: 
Private Sub CommandButton1_Click()
  Set bronRij = Sheets("Faktuur").Range("I33,C19,C33,E33,i66,K66")
        doelRij = Sheets("Debiteuren").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    x = 1
    For Each cel In bronRij
        Sheets("Debiteuren").Cells(doelRij, x) = cel.Value
        x = x + 1
    Next

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        FileName:="E:\" & Range("C19") & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
        [B37:K65].ClearContents
        [E33] = [E33 + 1]

    If FileName <> "" Then
        Mail_PDF_Outlook FileName, "jouwemail@jouwdomein.nl", "Hier komt het onderwerp", _
              "In de PDF file staan de laatste cijfertjes." _
            & vbNewLine & vbNewLine & "Met vriendelijke groet, <Jouw naam>", False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If

End Sub
Ik heb maar een deel van de tekst vertaald... Maar het gaat natuurlijk om de Mail functie:
Code: 
Function 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
Die heb ik letterlijk bij Ron uit zijn bestand gehaald. Hoef je dus helemaal niks aan te doen.
 
Michel bedankt voor je snelle reactie.
In de bovenste code zit helaas een fout.(Compileerfout).
en waar is de tweede code voor?
 
Als ik de functie uitvoer krijg ik ook een foutmelding. Komt waarschijnlijk doordat de PDF niet gemaakt wordt. En dan is er dus geen FileName, en kan er ook niks worden gemaild. Ron gebruikt zelf een andere techniek om de PDF te maken, en die werkt (uiteraard, zou ik bijna zeggen) in zijn eigen bestand in ieder geval perfect. Hij gebruikt deze routine:
Code: 
Sub Workbook_To_PDF_And_Create_Mail()
    Dim FileName As String

    'Call the function with the correct arguments
    FileName = Create_PDF(ActiveWorkbook, "", True, False)

    'For a fixed file name and overwrite it each time you run the macro use
    'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, False)

    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileName, "ron@debruin.nl", "This is the subject", _
                             "See the attached PDF file with the last figures" _
                           & vbNewLine & vbNewLine & "Regards Ron de bruin", False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to Save the file in arg 2 is not correct" & vbNewLine & _
               "You didn't want to overwrite the existing PDF if it exist"
    End If
End Sub
En die roept deze module aan:
Code: 
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

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", _
                filefilter:=FileFormatstr, Title:="Create PDF")
            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False we test if the PDF already exist
        'in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
            Type:=xlTypePDF, FileName:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function
Net als in het mailstuk wordt er dus een aparte functie aangeroepen om de handeling uit te voeren. En dat beantwoord gelijk je 2e vraag: de Sub procedure gebruikt 2 aparte functies om de PDF te genereren en om het bestand te mailen. Die functies heb je dus nodig, anders doet de code het niet. En die functies kun je op een willekeurige (nieuwe) module zetten. Zolang Excel ze maar kan vinden :)
 
Michel
Dank voor de info. De PDF wordt in mijn code wel aangemaakt. De bedoeling is (zoals in mijn code) dat er gegevens verplaats worden (tabblad debiteuren) en een aantal cellen gewist worden en een nieuw volgnummer.
De bedoeling is dat in mijn huidige code de e-mail wordt aangeroepen.
 
Je zult je eigen code dus enigszins aan moeten passen om e.e.a. te laten werken. De knop krijgt dan bijvoorbeeld deze code:
Code: 
Dim celletje As Range
Set celletje = ActiveSheet.Range("C19")
Dim sNaam As String
[B]sNaam [/B]= "H:\" & celletje.Value & ".pdf"
  
  Set bronRij = Sheets("Faktuur").Range("I33,C19,C33,E33,i66,K66")
        doelRij = Sheets("Debiteuren").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    x = 1
    For Each cel In bronRij
        Sheets("Debiteuren").Cells(doelRij, x) = cel.Value
        x = x + 1
    Next

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        FileName:=[B]sNaam[/B], _
        Quality:=xlQualityStandard, IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
        [B37:K65].ClearContents
        [E33] = [E33 + 1]

    If [B]sNaam [/B]<> "" Then
        Mail_PDF_Outlook [B]sNaam[/B], "jouwemail@jouwdomein.nl", "Hier komt het onderwerp", _
              "In de PDF file staan de laatste cijfertjes." _
            & vbNewLine & vbNewLine & "Met vriendelijke groet, <Jouw naam>", False
    End If
De functie wordt nu aangeroepen op basis van de variabele sNaam.
 
Code: 
Private Sub CommandButton1_Click()
    Set bronRij = Sheets("Faktuur").Range("I33,C19,C33,E33,i66,K66")
        doelRij = Sheets("Debiteuren").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    x = 1
    For Each cel In bronRij
        Sheets("Debiteuren").Cells(doelRij, x) = cel.Value
        x = x + 1
    Next
    fName = "E:\" & Range("C19") & ".pdf"
    Range("zet hier het bereik").ExportAsFixedFormat 0, fName
    [B37:K65].ClearContents
    [E33] = [E33 + 1]
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = "het emailadres"
        .CC = ""
        .BCC = ""
        .Subject = "eventueel een onderwerp"
        '.Body = StrBody
        .Attachments.Add fName
        .Display '.Send
        Else
    End With
End Sub
 
Beste Rudi,
Dit is het helemaal. Super en bedankt voor het meedenken.
Ron
 
Beste Rudi
Bedankt voor onderstaande code.
Ik heb nog een vraagje en dat is het volgende:Om de mail te verzenden zet je dat zo: .To = "" bestaat er ook de mogelijkheid dat het e-mail adres uit cel A11 gehaald wordt?
Alvast bedankt voor je hulp


Code: 
Private Sub CommandButton1_Click()
    Set bronRij = Sheets("Faktuur").Range("J33,C19,C33,F33,L62,L63,L64")
    doelRij = Sheets("Debiteuren").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    x = 1
    For Each cel In bronRij
        Sheets("Debiteuren").Cells(doelRij, x) = cel.Value
        x = x + 1
        Next
     ''ActiveSheet.PrintOut
       Fname = "C:\Fakturen\" & Range("C19") & ".pdf"
       Range("B6:L70").ExportAsFixedFormat 0, Fname
    [B37:J61].ClearContents
    [F33] = [F33 + 1]
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Betreft faktuurnr."
        '.Body = StrBody
        .Attachments.Add Fname
        .Display '.Send
      ''  Else
    End With
End Sub
 
Ik hoop niet dat je nu zo eenkennig bent dat alleen Rudi mag helpen, want dan kun je 'm beter een PM sturen...
Code: 
        .To = Range("A11")
 
Michel,
Bedankt voor de info
Ron

Zet status als opgelost
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan