macro voor het aanmaken van bestanden

[fotofons]

Ik ben in word bezig om via een macro bestanden aan te maken.
De eerste versie heb ik genaakt via opnemen:

    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy            \\hier lees ik de bestandsnaam in, nu 1234-xxxx
    ChangeFileOpenDirectory "S:\2012\"
    Documents.Open FileName:= _
        "S:\2012\org.docx", _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "FonsP"
        .Replacement.Text = "1234-xxxx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ChangeFileOpenDirectory "S:\2012\"
    ActiveDocument.SaveAs2 FileName:= _
        "S:\2012\1234-xxxx.docx" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
    ActiveDocument.Close
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1

Zet ik 1234-xxxx in een variabele dan gaat het fout bij het opslagen van het bestand.

    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Copy
    bestandsnaam = Selection
    ChangeFileOpenDirectory "S:\2012\"
    Documents.Open FileName:= _
        "S:\2012\org.docx", _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "FonsP"
        .Replacement.Text = bestandsnaam
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ChangeFileOpenDirectory "S:\2012\"
[COLOR="#FF0000"]    ActiveDocument.SaveAs2 FileName:= _
        "S:\2012\" & bestandsnaam  & ".docx" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14[/COLOR]    
ActiveDocument.Close
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1

Wie heeft de oplossing voor mij? TIA

 

[OctaFish]

Doe ons een lol en maak eerst je code op met de CODE knop. Dit is niet te lezen. En dan niet in een nieuw bericht zodat de oude code blijft staan, maar de origine code aanpassen.

 

[ReneDirks]

Ik heb net dit stukje code getest (met uiteraard een gedimensioneerde en gevulde variabele 'bestandsnaam' en en dat gewoon goed hoor. Welke foutmelding krijg je?

ActiveDocument.SaveAs2 FileName:= _
"C:\q\" & bestandsnaam & ".docx" _
, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14

 

[fotofons]

Ik krijg foutmelding 5096 (geel pijltje knippert bij de laatste regel: :=False, SaveAsAOCELetter:=False, CompatibilityMode:=14

Bij het selecteren van de tekst voor de bestandsnaam ging het fout. Ik had de hele regel geselecteerd (shift+End), dat moet 1 teken minder zijn (het einde Alinea-teken werd meegenomen) Dankzij je vraag naar de foutmelding probleem dus opgelost. BEDANKT voor je hulp.

 

[fotofons]

Doe ons een lol en maak eerst je code op met de CODE knop. Dit is niet te lezen. En dan niet in een nieuw bericht zodat de oude code blijft staan, maar de origine code aanpassen.

Bedankt voor de hint. Stukken beter.

 

[OctaFish]

Een veel veiliger methode van tekst selecteren is door het Paragraph object te gebruiken.

Dim myRange As Range
    
    Set myRange = ActiveDocument.Paragraphs(1).Range
    Tekst = myRange.Text
    MsgBox Tekst

 

[fotofons]

Dank je: weer iets bijgeleerd.

 

[OctaFish]

Laatste les: ophouden met (nodeloos) quooten; dat maakt de draadjes nodeloos onoverzichtelijk. Die knop heeft een onweerstaanbare aantrekkingskracht op nieuwe forumgebruikers, maar daar val jij toch niet meer onder? En zeg nu zelf: de oorspronkelijke tekst is toch vele malen beter als de quoots die je steeds maakt? Dus graag nog weghalen

 

[huijb]

Onnodige quotes verwijderd.

 

[snb]

Ik heb geen idee hoe je Wordbestand eruit ziet, maar als iedere alinea een bestandsnaam bevat kun je het bestand zo openen en opslaan.

Sub M_snb()
  sn=split(activeDocument.content,vbcr)

  for j=0 to ubound(sn)
    with document.add("S:\2012\" & sn(j))
      .Find.execute "FonsP","1234-xxx"
      .saveas2 .fullname  & ".docx", 12
      .close 0
    end with
  next
End Sub