Afdruk samenvoegen en opslaan als afzonderlijke pdf bestanden

[will1414]

Ik heb een document samengevoegd maar wil dit nu splitsen in pdf bestanden. De pdf bestanden moeten een naam krijgen bijv factuur 1.pdf factuur2.pdf etc
Ik heb de volgende macro, maar middels deze macro moet ik zelf de naam iedere keer invoeren. De naam zou eigenlijk moeten zijn een samenvoeging van factuur plus de counter, hoe kan ik dat doen. Alvast dank Will1414

Sub Splitter2()

' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.


Dim Letters As Integer, Counter As Integer
Dim DocName As String, sDoc As String

sDoc = "Brief "

Letters = 5
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
    Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
        wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
        wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
        PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Counter = Counter + 1
Wend
End Sub

 

[will1414]

Inmiddels krijg ik de pdf bestanden middels de volgende macro

Sub afzonderlijk2()

'
' Afzonderlijk2 zet basisbestand dat gekoppeld is aan excel voor mailmerge op in afzonderlijke pdf bestanden
' De basis, dus niet het al grote aaneengeschakelde bestand, gebruiken voor de macro
'

  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    With ActiveDocument.MailMerge
      .ViewMailMergeFieldCodes = False
      With .DataSource
        .ActiveRecord = wdLastRecord
        y = .ActiveRecord
        .ActiveRecord = wdFirstRecord
    
        For j = 1 To y
          ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "D:\" & .DataFields(2).Value & " " & Date & ".pdf", _
         ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
          If j < y Then .ActiveRecord = wdNextRecord
        Next
      End With
    End With
  End If
End Sub

Dit werkt perfect. In het achterliggende excelbestand staat ook een emailadres. Het pdf bestand wil ik eigenlijk naar het emailadres sturen. Hoe kan ik dit in de macro verwerken

Alvast dank
will1414

 

[leofact]

Dit bereik je op de manier van voorbeeld één uit deze link
Drie punten om in acht te nemen:
1. Deze methode is voor outlook
2. bij .Attachments.Add "C:\WINDOWS\WIN.INI" vervang je "C:\WINDOWS\WIN.INI" door: "D:\" & .DataFields(2).Value & " " & Date & ".pdf"
(of beter, wijs dat toe aan een string variable, die je dan hier gebruikt)
3. in het voorbeeld wordt .send gebruikt. Dit om direct te versturen. Outlook last dan vaak (zeker in serveromgeving) een irritante beveiligingspauze in.
in dat geval kun je m.i. beter .display gebruiken. Het mailtje wordt klaar gezet en eer hoeft alleen nog op verzenden geklikt te worden.
Natuurlijk bepaal je zelf wat voor jou het prettigst werkt.

Mvg Leo

 

[OctaFish]

@ will: code maak je op met de CODE tag of knop, zodat die netjes inspringt (ik neem aan dat je dat in het origineel ook doet) en het juiste lettertype krijgt. Op deze manier is de code nauwelijks snel te doorgronden. Dus graag met terugwerkende kracht de berichtjes alsnog netjes opmaken, en de volgende keer gelijk de CODE knop gebruiken

 

[crash]

Code tag in de berichten gezet.

 

[will1414]

Beste Leo,
ik ben echt nog een beginner dus heb wat vraagtekens bij jouw opmerking
Jij schrijft
1. Deze methode is voor outlook, maar kan ik dit dan wel gebruiken in een ms word makro:
2. bij .Attachments.Add "C:\WINDOWS\WIN.INI" vervang je "C:\WINDOWS\WIN.INI" door: "D:\" & .DataFields(2).Value & " " & Date & ".pdf"
(of beter, wijs dat toe aan een string variable, die je dan hier gebruikt)

Hier gaat de echte beginnenr zich laten zien, wat bedoel je precies met "wijs dat toe aan een string variable"

Punt 3 is helder.


Ik heb nu het volgende

Sub afzonderlijk3()

'
' Afzonderlijk2 zet basisbestand dat gekoppeld is aan excel voor mailmerge op in afzonderlijke pdf bestanden
' De basis, dus niet het al grote aaneengeschakelde bestand, gebruiken voor de macro
'

  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    With ActiveDocument.MailMerge
      .ViewMailMergeFieldCodes = False
      With .DataSource
        .ActiveRecord = wdLastRecord
        y = .ActiveRecord
        .ActiveRecord = wdFirstRecord
    
        For j = 1 To y
          ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "D:\" & .DataFields(1).Value & " " & Date & ".pdf", _
         ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

Dim Outlook_App As Object
Dim Outlook_Mail As Object


Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
On Error Resume Next
With Outlook_Mail
    .To = "aapje@xs4all.nl"
    
    .Subject = "Onderwerp e-mail"
         .Body = "Hier plaatst u de inhoud van het bericht"
         '.HTMLBody = "<HTML><P>TEST</P></HTML>"
         .NoAging = True
         .Attachments.Add "D:\" & .DataFields(1).Value & " " & Date & ".pdf" 'De locatie van de bijlage
         '.Display 'Laat e-mail zien voordat hij wordt verzonden
         '.Save 'Voorkomt de vraag om op te slaan, slaat op in Postvak In
         .Send   'Verzenden van e-mailbericht
    
    
End With
On Error GoTo 0

Set Outlook_Mail = Nothing
Set Outlook_App = Nothing
    
        
        
        
        If j < y Then .ActiveRecord = wdNextRecord
        Next
      End With
    End With
  End If
End Sub

Hij maakt de bestanden aan maar verstuurt ze niet.
Hij maakt wel mailtjes voor in dit geval aapje@xs4all.nl.

De vraag is dus wat ik moet aanpassen om ipv aapje@xs4all.nl de verschillende mail adressen te krijgen, en hoe zorg ik ervoor dat de pdf bestanden worden meegestuurd.

Alvast dank voor de hulp.

will1414

 

[leofact]

De methode opent de Outlook mail. Dit kan vanuit Word.
Aan een string (tekst) variabele kun je een stuk tekst toewijzen.

Dim sBestand as String 
sBestand = D:\" & .DataFields(2).Value & " " & Date & ".pdf
Attachments.Add sBestand

Dit laatste zou de de pdf als bijlage moeten toevoegen.

Mvg Leo

 

[OctaFish]

Zolang je .To = "aapje@xs4all.nl" als verzendadres gebruikt, zal je altijd naar aapje sturen. De vraag is dus: waar haal je de adressen vandaan? Ik neem aan dat je een Mergefield hebt?

 

[will1414]

Het is helder dat ik ipv aapje@xs4all.nl iets anders moet melden ik weet alleen niet wat. Het email adres is ook een veld in de sheet, Datafields (3), maar hoe moet ik dit beschrijven.
Alvast dank
Will1414

 

[OctaFish]

Lijkt mij niet zo lastig, aangezien je dezelfde constructie voor je bijlage gebruikt:

    [B][COLOR="#0000FF"].To = .DataFields(3).Value[/COLOR][/B]
    .Subject = "Onderwerp e-mail"
    .Body = "Hier plaatst u de inhoud van het bericht"
    '.HTMLBody = "<HTML><P>TEST</P></HTML>"
    .NoAging = True
    .Attachments.Add "D:\" & .DataFields(1).Value & " " & Date & ".pdf" 'De locatie van de bijlage
    '.Display 'Laat e-mail zien voordat hij wordt verzonden
    '.Save 'Voorkomt de vraag om op te slaan, slaat op in Postvak In
    .Send   'Verzenden van e-mailbericht

 

[will1414]

ik ben er bijna

Ik heb nu het volgende

Sub afzonderlijk4()

'
' Afzonderlijk2 zet basisbestand dat gekoppeld is aan excel voor mailmerge op in afzonderlijke pdf bestanden
' De basis, dus niet het al grote aaneengeschakelde bestand, gebruiken voor de macro
'

  If ActiveDocument.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
    With ActiveDocument.MailMerge
      .ViewMailMergeFieldCodes = False
      With .DataSource
        .ActiveRecord = wdLastRecord
        y = .ActiveRecord
        .ActiveRecord = wdFirstRecord
    
        For j = 1 To y
          ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "D:\" & .DataFields(1).Value & " " & .DataFields(2).Value & " " & Date & ".pdf", _
         ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

Dim sBestand As String
sBestand = "D:\" & .DataFields(1).Value & " " & .DataFields(2).Value & " " & Date & ".pdf"
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
On Error Resume Next
With Outlook_Mail
    .To = "aapje@gmail.com"
    
    .Subject = "Onderwerp e-mail"
         .Body = "Hier plaatst u de inhoud van het bericht"
         '.HTMLBody = "<HTML><P>TEST</P></HTML>"
         .NoAging = True
         .Attachments.Add sBestand
         '.Display 'Laat e-mail zien voordat hij wordt verzonden
         '.Save 'Voorkomt de vraag om op te slaan, slaat op in Postvak In
         .Send   'Verzenden van e-mailbericht
    
    
End With
On Error GoTo 0

Set Outlook_Mail = Nothing
Set Outlook_App = Nothing
    
        
        
        
        If j < y Then .ActiveRecord = wdNextRecord
        Next
      End With
    End With
  End If
End Sub

Attachments worden allen naar aapje@gmail.com gestuurd. Wanneer ik ipv .To = "aapje@gmail.com" .To = .DataFields(3).Value gebruik wordt er geen mail gestuurd terwijl in de 3e kolom wel eem mailadres staat.
Wie kan mij met dit laatste nog helpen.,
Alvast dank