Verzendlijst word, brieven opslaan.

  • Onderwerp starter Onderwerp starter covux
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

covux

Gebruiker
Lid geworden
9 sep 2016
Berichten
99
Hey,

Ik heb een verzendlijst in Word gekoppeld aan een Excel bestand met allerlei adres gegevens.
Nu ben ik zo ver dat ik automatisch al die brieven met juiste gegevens kan printen.

Nu moet ik echter nog elke brief apart kunnen opslaan zodat de juiste brief bij de juiste klant in het system komt te staan.

Heeft iemand hiervoor een handige oplossing.

Ik weet dat je een macro kan maken en dat er genoeg te vinden zijn op het internet.
echter snap ik nog niet veel van VBA en lukt het mij ook niet om eentje werkende te krijgen die ik vind op het internet

Als ik de documenten als kan opslaan als Brief "naam klant" ben ik al blij.

covux
 
Je snapt vermoedelijk wel dat zoiets niet standaard in Word zit; je zult dat met een macro moeten doen. Niet dat dat erg is, als die macro niet zelf bedacht hoeft te worden. En dat hoeft niet, hij staat in dit draadje. Dit is een macro die ik zelf ook maar ergens gevonden heb, en enigszins aangepast om unieke namen te genereren. Het origineel gaf elk document dezelfde naam met een volgnummer. Niet erg handig natuurlijk. Deze doet dat wel, op basis van de eerste alinea. Dat kun je wellicht zelf nog aanpassen als je dat wilt.
Het principe is simpel: een samenvoeg resultaat bestaat altijd uit secties, voor elk adres één. En de macro splitst de secties op in eigen documenten. Kijk maar eens of je er uit komt,
 
OctaFish,

Dankjewel voor je antwoord!

het ziet er goed uit.

Als ik de macro wil doen krijg ik alleen de volgende fout melding.
Compileer fout:
sub of function is niet gedefinieerd.


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("Desktop") & "\Brieven"
If CreateFolder(Pad) = False 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(1).Range
    DocName = 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:=wdFormatDocument, _
    Password:="", AddToRecentFiles:=True, WritePassword:="", EmbedTrueTypeFonts:=False, _
    SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.Close
    Counter = Counter + 1
Wend

End Sub

De fout ligt bij de "CreateFolder(Pad)"
als ik de module wil runnen dan wordt dit stukje blauw.


Groet
Covux
 
Laatst bewerkt:
Ah, dat klopt, die ontbreekt :). Had ik in het andere draadje er ook niet bij gezet zag ik. Dat is deze functie:
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:
    Exit Function
End Function
 
Octrafish,

bedankt voor dit stukje code.

waar moet ik het plaatsen?

IK ben een beetje aan het spelen geweest maar krijg het niet werkende.
soms krijg ik allemaal errors. en soms voer hij de macro wel uit maar zie ik geen resultaat.

in Pad = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Brieven"

Heb ik "Desktop"wel vervangen naar "bureuablad" omdat ik de NL versie van Windows heb.
moet ik dit op meer plaatsen doen?

Covux
 
Ik gebruik ook de Nederlandse Windows maa toch gebruik ik 'Desktop'. En dat komt omdat SpecialFolders nu eenmaal op,die manier gedefinieerd zijn. Tenzij je een oudere Windows gebruikt. Loop maar eens door de SpecialFolders collectie om alle namen uit te lezen.
De functie zelf kun je neerzetten waar je wilt. Kwestie van een module aanmaken en plakken; Word vind hem gelijk.
 
Octafish,

Kan ik van beide stukjes code 1 module maken, zodat ik dan twee modules heb?

tot nu toe heb ik alles in 1 proberen te krijgen. :)

code maken enzo is nog net iets te veel voor mij.

Heb jij toevallig nog tips of kan jij mij websites aanraden waar ik programmeren in VBA goed kan leren?

Groet
Covux
 
Kan ik van beide stukjes code 1 module maken, zodat ik dan twee modules heb? tot nu toe heb ik alles in 1 proberen te krijgen. :)
Dit snap ik niet: als je van alle code één module maakt, heb je er toch geen twee? Modules zijn niets meer als containers waar je spullen in zet zet. Hoeveeel modules je maakt, of hoe ze heten, doet er totaal niet toe. Al maak je er 50, voor elke macro één. Zolang ze maar een unieke naam hebben (geldt voor zowel macro als module) zal het Word een worst wezen. Ik heb sjablonen met één module, en sjablonen met 10. In de laatste zitten dermate veel macro's dat ik ze niet in één module wil hebben omdat ik er anders een scrollarm aan overhoud. Dat is (naast het feit dat je modules zinvolle namen kunt geven en functies op basis van hun functionaliteit dan bij elkaar zet) voor mij de enige reden om meer dan één module te gebruiken. Is het aantal macro's laag, dan is er geen enkele reden te bedenken om daar een aparte module voor te gebruiken.
 
Volgens mij heb ik het word bestand niet opgeslagen als sjabloom. is dit ook belangrijk?

werken met macro's is nog helemaal nieuw voor mij :)

Update:

Ik heb nu beide stukjes in 1 module gedaan.


Nu krijg ik echter een nieuwe foutmelding.

Fout 13 tijdens uitvoering: Typen komen niet met elkaar overseen

hij geeft wederom deze regel aan

Code:
 If CreateFolder(Pad) = False Then
 
Laatst bewerkt:
Doe er eens een bestandje bij met de macro's zoals je ze nu hebt. Omdat je geen docm bestanden kunt uploaden met je het bestand dan eerst zippen. De extensie veranderen naar .xlsb mag ook , want dat pikt HelpMij dan weer wel.
 
Ik zie geen macro's; waar staan die?
 
niet onder,

ontwikkelaars -> Macro's en dan Splitter?

Of heb ik die dan ergens apart op mijn PC opgeslagen?

update.

Heb het denk ik nu ook als .bas opgeslagen. Wil je die?
 
Laatst bewerkt:
Is ook goed; ik vermoed dat je de macro's in de Normal.dot had neergezet.
 
Mijn laptop is gesneuveld, dus ik zit een beetje krap qua hardware. Maar ik zal er naar proberen te kijken...
 
ohh jammer,

het heeft gelukkig geen haast, kijk maar wanneer je dan tijd hebt :)
 
Heb gelukkig nog een laptop in huis staan :). Hier de aangepaste code (er zaten inderdaad wat kleine foutjes in)
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(1).Range
        DocName = 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.Convert
        ActiveDocument.SaveAs FileName:=Pad & DocName & ".docx", FileFormat:=wdFormatDocumentDefault
        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
 
Bedankt voor de code!

De code lijkt te werken.
Ik krijg geen foutmelding als ik het code laat runnen.

Ook zie ik in mjn documenten een nieuwe map genaamd "Brieven".

Echer lukt het mij nog niet om de lijsten op te slaan.

ALs ik een verzendlijst heb en ik gebruik de macro gebeurd er niks.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan