title image


Smiley Re: Wörter finden u. augeben in eine Liste


Option Explicit



' baut im gleichen Verzeichnis wie das Dokument eine Textdatei mit dem Ergebnis ein



Sub Word_Auslesen()



Dim Dc As Document, rn As Range, Fs, Txt

    

    Set Dc = ActiveDocument

    If Dc.Path = vbNullString Then _

      Set Dc = Nothing: Exit Sub

    Set Fs = CreateObject("Scripting.Filesystemobject")

    Set Txt = Fs.CreateTextFile(Dc.Path & "\" & Fs.GetBaseName(Dc.Name) & ".txt", Overwrite:=True)

          

          Set rn = Dc.Content

          rn.Find.ClearFormatting

          Do While rn.Find.Execute(FindText:="ung", Forward:=True, Format:=True) = True

             Set rn = rn.Find.Parent

             rn.Expand Unit:=wdWord

             Txt.WriteLine rn.Text

             Set rn = Dc.Range(Start:=rn.End + 1, End:=Dc.Range.End - 1)

          Loop

          Txt.Close



    Set Dc = Nothing: Set rn = Nothing: Set Fs = Nothing: Set Txt = Nothing



End Sub



 Code eingefügt mit Syntaxhighlighter 1.16

Knofi So wie wir heute arbeiten, werden morgen die Beamten leben ...

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: