samenvoegbestand individueel bewaren met naam in veld

[rcmb]

Ik heb een vraag over het bewaren van een mailing van circa 100 brieven. Ik zou deze mailing graag apart willen bewaren als pdf, op zich geen probleem en ik weet hoe ik deze weer kan splitsen in pdf.
In acrobat heb ik geen mogelijkheid om daar een aparte naam aan te geven anders dan een nummering. Ik denk dus dat dit via word zou moeten worden gedaan.

Het gaat mij erom dat ik de afzonderlijke brieven een naam zou willen geven die bestaat uit een vast tekst vooraf gegaan met de naam van geadresseerde. In het voorbeeld respectievelijk ABC mailing 25 oktober 2018, Ruuten mailing 25 oktober 2018 en Jansen mailing 25 oktober 2018. Er zit in de brief die 1 pagina heeft, een logo in de header? omdat het een merge is, zal de layout dus altijd hetzelfde zijn. Bekijk bijlage Mailing test.docx

Weet iemand of en hoe dat kan.

 

[snb]

Hier lukt het met:

Sub M_snb()
   For Each it In ThisDocument.Sections
      If it.Index = ThisDocument.Sections.Last.Index Then Exit For
      ThisDocument.Range(it.Range.Start, it.Range.End - 1).ExportAsFixedFormat "G:\OF\" & Replace(Replace(Replace(it.Range.Paragraphs(4).Range.Text, " ", "_"), ".", "_"), vbCr, "") & ".pdf", 17
   Next
End Sub

 

[rcmb]

hartelijk dank dit werkt, Ik heb de directory aangepast. Kan ik ook behalve de naam van veld 1 een voorvoegsel zetten zoals " overzicht 27 oktober abc_BV" ipv ABC_BV. en zou ik de toevoeging de heer P kunnen laten vervallen?

Mag ik nog even een vervolg vraag stellen. ALs ik bijvoorbeeld op het rekeningnummer zou willen selecteren, gaat dat ook. zodat hij het op het rekening nummer kan bewaren?

 

[OctaFish]

Codes van snb zijn doorgaans kort van regels, en specifiek voor de taak die is gevraagd door een TS. Aanpassen (überhaupt begrijpen) ervan is vaak nog een hele klus. Ik opteer meestal voor een variant die wat logischer (voor mij) in elkaar zit, en waar makkelijker aanpassingen in te maken zijn. En dan kom ik tot zoiets:

Sub SplitterPDF()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Created by snb, adapted by Octafish
'------------------------------------------------------------------------------------------------------------------
Dim DocName As String, Pad As String
Dim aDoc As Document, iT As Section

    If Dir(CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Brieven\", vbDirectory) & "" = "" Then
        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
    Else
        Pad = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Brieven\"
    End If
    If Not Right(Pad, 1) = Application.PathSeparator Then Pad = Pad & Application.PathSeparator
    
    Set aDoc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    For Each iT In aDoc.Sections
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        '==========================================================================================================
        ' Variant met naam
        ''DocName = Replace(iT.Range.Paragraphs(4).Range.Text, vbCr, "")
        ''Select Case Left(DocName, 7)
        ''    Case Is = "mevrouw", "de heer"
        ''        DocName = Split(DocName, " ")(UBound(Split(DocName, " ")))
        ''End Select
        '----------------------------------------------------------------------------------------------------------
        ' Variant met rekeningnummer
        DocName = Replace(Replace(iT.Range.Paragraphs(14).Range.Text, vbCr, ""), Chr(12), "")
        '==========================================================================================================
        DocName = DocName & " mailing " & Format(Date, "d mmmm yyyy") & ".pdf"
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        aDoc.Range(iT.Range.Start, iT.Range.End - 1).ExportAsFixedFormat Pad & DocName, 17
    Next

End Sub

 

[rcmb]

Dank voor je toevoeging, ik begrijp hier iets meer van omdat ik een paar dingen herken die ik dan ook kan aanpassen.
Ik probeerde je macro te laten werken, zonder en met aanpassing maar krijg een foutmelding "Complieerfout Sub of Function is niet gedefinieerd" bij If CreateFolder(Pad) = "Mislukt" Then.

 

[OctaFish]

Had ja, dat klopt. Ik heb een extra functie die een pad aanmaakt als dat pad niet bestaat. Jij hebt je pad al, dus je hebt die functie niet nodig. Dat deel kun je dus gerust verwijderen.

 

[rcmb]

ik heb de code nu wat aangepast en heb op allerei manieren geprobeerd maar krijg alleen maar foutmeldingen

Sub SplitterPDF()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Created by snb, adapted by Octafish
'------------------------------------------------------------------------------------------------------------------
Dim DocName As String, Pad As String
Dim aDoc As Document, iT As Section

    If Dir(CreateObject("WScript.Shell").SpecialFolders("C:\Users\Ruud\Documents\Ruud\pdf\") & "\Brieven\", vbDirectory) & "" = "" Then
        Pad = CreateObject("WScript.Shell").SpecialFolders("C:\Users\Ruud\Documents\Ruud\pdf\") & "\Brieven\"
        'If CreateFolder(Pad) = "Mislukt" Then
            'MsgBox "Het pad kon niet worden aangemaakt; check de gegevens."
            'Exit Sub
        'End If
    'Else
        Pad = CreateObject("WScript.Shell").SpecialFolders("C:\Users\Ruud\Documents\Ruud\pdf\") & "\Brieven\"
    End If
    If Not Right(Pad, 1) = Application.PathSeparator Then Pad = Pad & Application.PathSeparator
    
    Set aDoc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    For Each iT In aDoc.Sections
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        '==========================================================================================================
        ' Variant met naam
    DocName = Replace(iT.Range.Paragraphs(4).Range.Text, vbCr, "")
    Select Case Left(DocName, 7)
    Case Is = "mevrouw", "de heer"
    DocName = Split(DocName, " ")(UBound(Split(DocName, " ")))
    End Select
        '----------------------------------------------------------------------------------------------------------
        ' Variant met rekeningnummer
        DocName = Replace(Replace(iT.Range.Paragraphs(14).Range.Text, vbCr, ""), Chr(12), "")
        '==========================================================================================================
        DocName = DocName & " mailing " & Format(Date, "d mmmm yyyy") & ".pdf"
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        aDoc.Range(iT.Range.Start, iT.Range.End - 1).ExportAsFixedFormat Pad & DocName, 17
    Next

End Sub

 

[OctaFish]

Graag aangeven wáár je die foutmeldingen krijgt, want dat kunnen wij niet ruiken natuurlijk. En ik zou dus, als ik jou was, de hele mappencheck er uit gooien, want die heb je niet nodig. Ik moet zeggen: toen ik de code op mijn werk testte, kreeg ik ook een foutmelding. Ik wijtte dat aan de netwerkinstellingen. Maar thuis nog niet kunnen testen.

 

[rcmb]

Ik heb dit nu als macro en krijg de volgende foutmelding Fout 2147467258(800004005) tijdens uitvoering
Dit is geen geldige bestandnaam

Sub SplitterPDF()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Created by snb, adapted by Octafish
'------------------------------------------------------------------------------------------------------------------
Dim DocName As String, Pad As String
Dim aDoc As Document, iT As Section

        
    Set aDoc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    For Each iT In aDoc.Sections
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        '==========================================================================================================
        ' Variant met naam
    DocName = Replace(iT.Range.Paragraphs(4).Range.Text, vbCr, "")
    Select Case Left(DocName, 7)
    Case Is = "mevrouw", "de heer"
    DocName = Split(DocName, " ")(UBound(Split(DocName, " ")))
    End Select
        '----------------------------------------------------------------------------------------------------------
        ' Variant met rekeningnummer
        DocName = Replace(Replace(iT.Range.Paragraphs(14).Range.Text, vbCr, ""), Chr(12), "")
        '==========================================================================================================
        DocName = DocName & " mailing " & Format(Date, "d mmmm yyyy") & ".pdf"
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        aDoc.Range(iT.Range.Start, iT.Range.End - 1).ExportAsFixedFormat Pad & DocName, 17
    Next

End Sub

 

[OctaFish]

Wij willen graag weten op welke regel. Die bestandsnaam bestaat uit twee delen: je pad en de naam uit het document. Beiden kunnen een fout bevatten. Ik raadde je aan om het pad gelijktijdig de string te zetten, omdat je het pad al weet, dus daar mag geen fout in zitten. Dan hou je alleen de feitelijke naam over, die uit je document komt.

 

[rcmb]

dank voor je reactie. Maar heb geen idee wat en waar ik dat zou moeten aanpassen.

 

[OctaFish]

Wij ook niet . Zul je toch eerst moeten zeggen waar je de fout krijgt, en wat er in de betreffende variabelen zit. Dat laatste kun je zien door, als de code in Stap modus staat, of stopt bij een fout, je cursor boven de variabele te houden. Of de variabelen te bekijken in het scherm <Lokale variabelen>.

 

[rcmb]

Zou je wel kunnen laten weten welk gedeelte er sowieso af moet vanwege de melding over de padname?

 

[OctaFish]

Dat is lastig. De code werkt bij mij prima, dus je zult aan moeten geven wat hij wel invult, en wat niet.

 

[rcmb]

Sub SplitterPDF()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Created by snb, adapted by Octafish
'------------------------------------------------------------------------------------------------------------------
Dim DocName As String, Pad As String
Dim aDoc As Document, iT As Section

    
    
    Set aDoc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    For Each iT In aDoc.Sections
        If iT.Index = aDoc.Sections.Last.Index Then Exit For
        '==========================================================================================================
        ' Variant met naam
    DocName = Replace(iT.Range.Paragraphs(4).Range.Text, vbCr, "")
    Select Case Left(DocName, 7)
    Case Is = "mevrouw", "de heer"
    DocName = Split(DocName, " ")(UBound(Split(DocName, " ")))
    End Select
        '----------------------------------------------------------------------------------------------------------
        ' Variant met rekeningnummer
        ' DocName = Replace(Replace(iT.Range.Paragraphs(14).Range.Text, vbCr, ""), Chr(12), "")
        '==========================================================================================================
    DocName = DocName & " mailing " & Format(Date, "d mmmm yyyy") & ".pdf"
    If iT.Index = aDoc.Sections.Last.Index Then Exit For
    aDoc.Range(iT.Range.Start, iT.Range.End - 1).ExportAsFixedFormat Pad & DocName, 17
    Next

End Sub

Na de laatste regel aDoc. Range (IT.... ,17 krijg ik een melding fout -214 … Dit is geen geldige bestandsnaam als ik het stap voor stap doe.

Helpt dit?

 

[OctaFish]

Post eens een nieuw voorbeeldje, of gaat het ook in je eerste bijlage fout?

 

[rcmb]

ik heb het eerste bestand weer geprobeerd en de macro toegevoegd zoals ik due hierboven heb gepost. Ik heb dus de eerste commando' s verwijdert. Ik gebruik dus de code die ik hierboven heb gepost en krijg de volgende meldingen of dingen die mij opvallen,

Ik heb, zoals je mij had geadviseerd, de code stap voor stap doorlopen.
Het viel mij op dat bij de eerste 2 regels t.w. Dim Docname …. As String en Dim aDoc …iT As section niet geel wordt maar wordt overgeslagen. Vervolgens doet hij hetzelfde bij het onderdeel ‘variant naam bij de regel Docname = SPLIT……” “ )))

Na de regel aDoc range(iT….& DocName, 17 krijg ik deze melding “ Methode ExportAsFixedFormat van object Range is mislukt”

Ik zou het overigens wel fijn vinden als ik een verwijzing zou kunnen maken naar een map zodat de bestanden daar worden bewaard.

 

[OctaFish]

Dim regels worden altijd overgeslagen bij de stapmodus, want dat zijn geen acties. En dat geldt ook voor commentaar regels. Dus dat klopt wel. Welke Office versie gebruik je?

 

[rcmb]

Dim regels worden altijd overgeslagen bij de stapmodus, want dat zijn geen acties. En dat geldt ook voor commentaar regels. Dus dat klopt wel. Welke Office versie gebruik je?

 

[rcmb]

Dank voor je reactie. Ok viel mij alleen op. Office 365