Mailing to PDF

Status
Niet open voor verdere reacties.
B

BenO2019

Gebruiker
Lid geworden
21 okt 2019
Berichten
9
Ik heb een mailing test brief als bijlage die ik graag na het samenvoegen wil bewaren als een pdf, dit is een mailing met 250 adressen. Ik zou van deze mailing 250 brieven de pdf graag als individuele pdf willen bewaren als Factuur Q4, 2019 met de waarde/inhoud van het veld Factuurnummer. Is dit mogelijk? Kan hij dan uiteindelijk ook bewaard worden in een apart map op het bureaublad PDF facturen?
 

Bijlagen

  • Test brief.docm
    26,3 KB · Weergaven: 27
Dat wordt erg lastig, maar is niet onmogelijk. Om te beginnen: je hebt een macro nodig die je brieven splitst. Dat zou deze kunnen zijn:

Code: 
Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
' 20140102 Aangepast door OctaFish om documenten los op te slaan m.b.v. de naam in de 1e alinea.
' 20141210 Macro gebruikt nu een functie om op te slaan in een aparte map op de desktop van de user.
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String, Pad As String
Dim aRange As Range

    DocName = "Brief "
    Pad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Brieven\"
    If CreateFolder(Pad) = "Mislukt" Then
        MsgBox "Het pad kon niet worden aangemaakt; check de gegevens."
        Exit Sub
    End If
    If Not Right(Pad, 1) = Application.PathSeparator Then Pad = Pad & Application.PathSeparator
    
    Letters = ActiveDocument.Sections.Count
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    
    While Counter < Letters
        ActiveDocument.Sections.First.Range.Cut
        Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------
        'Naam samenstellen uit 1e alinea van tekst
        '-----------------------------------------------------------------------------
        Set aRange = ActiveDocument.Paragraphs(8).Range
        DocName = Split(aRange.Text, ":")(UBound(Split(aRange.Text, ":")))
        If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
            DocName = Left(DocName, Len(DocName) - 1)
        End If
        '-----------------------------------------------------------------------------
        ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
''        ActiveDocument.SaveAs FileName:=Pad & DocName & ".docx", FileFormat:=wdFormatDocumentDefault
        ActiveDocument.SaveAs FileName:=Pad & DocName & ".pdf", FileFormat:=wdFormatPDF
        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub

Code: 
Public Function CreateFolder(sFolder As String) As String
On Error GoTo ErrorHandler
Dim sF As String
    
    sF = Left(sFolder, InStrRev(sFolder, "\", Len(sFolder)) - 1)
    If Dir(sF, vbDirectory) = "" Then
      sF = CreateFolder(sF)
      MkDir sF
    End If
    CreateFolder = sFolder
    Exit Function
    
ErrorHandler:
    CreateFolder = "Mislukt"
End Function

Ik heb je document een beetje opgeschoond (alle overtollige lege alinea's bijvoorbeeld er uit gegooid) en dan is bij mij alinea 8 de alinea met het factuurnummer. Die alinea splits je om het factuurnummer er uit te vissen. Dat is dan de variabele DocName.
 
Dank voor je input ik probeer hem in de brief te verwerken als module

ik krijg als ik het commando doorloop bij Create Folder(Pad) een compileerfout, dat de sub of Function niet is gedefinieerd? of ligt dat aan mijn instellingen?

Ik neem aan dat het laatste Wend moet zijn end? Had jij de opgeschoonde brief ook toe moeten voegen of maakt dat niet uit.

Code: 
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String, Pad As String
Dim aRange As Range

    DocName = "Brief "
    Pad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Brieven"
    If [B][U]CreateFolder(Pad)[/U][/B] = "Mislukt" Then
        MsgBox "Het pad kon niet worden aangemaakt; check de gegevens."
        Exit Sub
    End If
    If Not Right(Pad, 1) = Application.PathSeparator Then Pad = Pad & Application.PathSeparator
    
    Letters = ActiveDocument.Sections.Count
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    
    While Counter < Letters
        ActiveDocument.Sections.First.Range.Cut
        Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------
        'Naam samenstellen uit 1e alinea van tekst
        '-----------------------------------------------------------------------------
        Set aRange = ActiveDocument.Paragraphs(8).Range
        DocName = Split(aRange.Text, ":")(UBound(Split(aRange.Text, ":")))
        If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
            DocName = Left(DocName, Len(DocName) - 1)
        End If
        '-----------------------------------------------------------------------------
        ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
''        ActiveDocument.SaveAs FileName:=Pad & DocName & ".docx", FileFormat:=wdFormatDocumentDefault
        ActiveDocument.SaveAs FileName:=Pad & DocName & ".pdf", FileFormat:=wdFormatPDF
        ActiveWindow.Close
        Counter = Counter + 1
    [B][U]Wend[/U][/B]

End Sub"
 
Laatst bewerkt:
Heb je die functie in een moduleblad gezet? Anders kan-ie hem niet vinden.
 
Ik ben via ontwikkelaars naar macro maken voor dit document, de tekst code erin gekopieerd, onder algemeen. Vervolgens op F5 gedrukt krijg ik de melding.

Ik heb het ook geprobeerd met VBA, invoegen module en vervolgens de code erin gekopieerd, F5, en zelfde fout. Ik zie de macro wel staan in Macro's

Je begrijpt, hoop ik, dat ik geen expert ben in VBA
 
Kijk eens, in het VBA venster, of je de Office Object Library aan hebt staan (<Extra>, <Verwijzingen>). Zo niet: even aanzetten en nog eens proberen.
 
Ja, deze staan allebei aangevinkt.
Microsoft Word 16.0 object Library en Microsoft office 16.0 Object Library
 
Kan je niet ook een anonieme versie van het gegevensbestand erbij plaatsen?
Nu krijgen we allerlei meldingen bij het openen van het word-bestand.
 
ik hoop dat dit iets toevoegt. bijgaand een geanonimiseerd voorbeeld van 3 brieven
 

Bijlagen

  • Facturen Q4, 2019 test.docx
    24,8 KB · Weergaven: 23
De macro doet het prima, maar je gegevens zijn niet consistent. Om te beginnen: je gebruikt Regeleindes bij de factuurgegevens. De macro haalt het het factuurnummer echter uit een alinea. Dat zul je dus moeten aanpassen. Veel erger: het factuurnummer staat bij de eerste brief in alinea 11, en bij de volgende in alinea 12. Dat kan de macro op deze manier nooit uitvogelen. Zorg ervoor dat het factuurnummer altijd in dezelfde alinea is te vinden.

Code: 
Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
' 20140102 Aangepast door OctaFish om documenten los op te slaan m.b.v. de naam in de 1e alinea.
' 20141210 Macro gebruikt nu een functie om op te slaan in een aparte map op de desktop van de user.
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String, Pad As String
Dim aRange As Range
Dim aDoc As Document, aDocNew As Document
    
    Set aDoc = ActiveDocument
    DocName = "Brief "
    Pad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Brieven\"
    If CreateFolder(Pad) = "Mislukt" Then
        MsgBox "Het pad kon niet worden aangemaakt; check de gegevens."
        Exit Sub
    End If
    If Not Right(Pad, 1) = Application.PathSeparator Then Pad = Pad & Application.PathSeparator
    
    Letters = ActiveDocument.Sections.Count
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    
    While Counter < Letters
        aDoc.Sections.First.Range.Copy
        Set aDocNew = Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------
        'Naam samenstellen uit 1e alinea van tekst
        '-----------------------------------------------------------------------------
        Set aRange = aDocNew.Paragraphs(11).Range
        DocName = Split(aRange.Text, ":")(UBound(Split(aRange.Text, ":")))
        If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
            DocName = Left(DocName, Len(DocName) - 1)
        End If
        '-----------------------------------------------------------------------------
        aDocNew.SaveAs FileName:=Pad & DocName & ".pdf", FileFormat:=wdFormatPDF
        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub

Code: 
Public Function CreateFolder(sFolder As String) As String
On Error GoTo ErrorHandler
Dim sF As String
    
    sF = Left(sFolder, InStrRev(sFolder, "\", Len(sFolder)) - 1)
    If Dir(sF, vbDirectory) = "" Then
      sF = CreateFolder(sF)
      MkDir sF
    End If
    CreateFolder = sFolder
    Exit Function
    
ErrorHandler:
    CreateFolder = "Mislukt"
End Function
 
Ik heb het nogmaals geprobeerd op een stand alone laptop en het werkt gedeeltelijk. Na het uitvoeren van de macro wordt er een nieuw document in word geopend. Vervolgens schrijft de macro alleen het eerste document met het juiste rekening nummer in pdf bestand "brieven", dus als in het voorbeeldbestand 12345.pdf, mis dus ook voorloper "brief" of "factuur". Hij bewaard hem wel ipv 1 op 2 paginas. De rest van de documenten worden in een sequence geopend als .doc document, die kan ik vervolgens één voor één bewaren, bij het bewaren wordt de naam de eerst tekens van het document en bewaard als een deheer.doc

Ik begrijp dat de layout van de regels niet consequent is omdat vaak regel 13 het rekeningnummer is en soms regel 14.Dit wordt veroorzaakt door de adressering, waarbij als het een bedrijfsnaam betreft de 2de regel start met de naam van het bedrijf, dit zorgt ervoor dat het geheel 1 regel opschuift. Ik vind dit niet zo'n probleem omdat dan de naam zal starten met een datum, die zou ik er later uit kunnen halen, de macro aanpassen aan regel 14 en hetzelfde doen. Ik begrijp ook niet zo goed waardoor het bewaren van de pdf na de eerste pdf stopt.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan