Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

bestimmte Zeilen aus Word-Datei auslesen

Betrifft: bestimmte Zeilen aus Word-Datei auslesen von: roman
Geschrieben am: 29.07.2014 10:46:13


Es gab zwar schon einen Beitrag dazu, jedoch brauche ich eine Copy-Paste-Variante des Programmtextes, da ich mich zu wenig mit VBA auskenne.

"Betrifft: bestimmte Zeilen aus Word-Datei auslesen
von: Claudia
Geschrieben am: 09.12.2010 15:46:10"

Meine Problemstellung:
Es soll aus ca. 200 einseitigen gleich aufgebauten Word Dateien (alle im selben Verzeichnis) ein Absatz ausgelesen und untereinander in einer Excel Datei aufgelistet werden.
Funktioniert das ganze so, dass ich das Makro in Excel erstelle?

  

Betrifft: AW: bestimmte Zeilen aus Word-Datei auslesen von: fcs
Geschrieben am: 29.07.2014 16:05:27

Hallo Roman,

die Erstellung der Liste aus Excel heraus ist möglich.

Aber muss es unbedingt per Copy und Paste sein? "Einfach" den Text nach Excel in eine Zelle übernehmen ist einfacher.

Nachfolgend das Gerüst eines Makros.
Es sind 2 Varianten einegebaut, die du über die Goto ... Zeilen steuern/anpassen kannst.

Variante1: Es wird der X-te Absatz/Paragraph kopiert - in meinem Beispiel der 3. Absatz.

Variante2: Es wird ein bestimmtes Wort gesucht. Der zu kopierende Word-Text wird auf den gesamten Absatz mit der Fundstelle erweitert.

Gruß
Franz

'Erstellt unter MS Office 2010
'Code in einem allgemeinen VBA-Modul der Exceldatei
Sub Hole_Wordtexte()
  Dim strFileName As String
  Dim objWDApp As Object 'Word.Application
  Dim objDoc As Object  'Word.Document
  Dim wdRange As Object ' Word.Range
  Dim wks As Worksheet
  
  Dim letztezeile
  Dim varVerzeichnis
  
  'On Error Resume Next
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Bitte Verzeichnis mit den Worddateien auswählen"
    If .Show = -1 Then
      varVerzeichnis = .SelectedItems(1)
    Else
      GoTo Beenden
    End If
  End With
  
  
  Set wks = ActiveSheet
  With wks
    letztezeile = .Cells(.Rows.Count, 1).End(xlUp).Row
  End With
  
  strFileName = Dir(varVerzeichnis & "\" & "*.doc")
  If strFileName <> "" Then
    Set objWDApp = CreateObject("Word.Application")
    objWDApp.Visible = True
  Else
    MsgBox "Keine Worddateien im gewählten Verzeichnis"
    GoTo Beenden
  End If
  
  
  Do Until strFileName = ""
    'Worddatei schreibgeschützt öffnen
    Set objDoc = objWDApp.Documents.Open(varVerzeichnis & "\" & strFileName, _
            ReadOnly:=True)
    'nächste freie Zeile Zeile in Excelblatt in Spalte B
    With wks
      letztezeile = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
      .Cells(letztezeile, 1) = objDoc.Name
    
GoTo Weiter_Suchen
    '3. Absatz/Paragraph = zu kopierendes Word-Objekt
      Set wdRange = objDoc.Paragraphs(3).Range
GoTo Weiter01:

Weiter_Suchen:

'zu kopierendes Wordobjekt via Suchfunktion bestimmen
      Set wdRange = objDoc.Content
      wdRange.Find.ClearFormatting
      wdRange.Find.Execute Findtext:="Copy:", Forward:=True      'Suchtext anpassen!!
      
      If wdRange.Find.Found = True Then
        'Fundstelle auf den gesamten Absatz erweitern
        wdRange.Expand 4 ' 4 = wdParagraph
        If wdRange.End = objDoc.Content.End Then
          'Fundstelle ist im letzten Absatz des Worddokuments
          Set wdRange = objDoc.Range( _
              Start:=objDoc.Paragraphs(objDoc.Paragraphs.Count - 1).Range.End, _
              End:=objDoc.Content.End - 1)
        End If
      Else
        Set wdRange = Nothing
      End If
      
Weiter01:
      If wdRange Is Nothing Then
          .Cells(letztezeile, 2).Value = "Suchebegriff nicht gefunden"
      Else
      
'GoTo Weiter02:
  'Word-Range kopieren und in Excel einfügen
          wdRange.Copy
          .Cells(letztezeile, 2).Select
          .Paste
GoTo Weiter03:

Weiter02:
  'Alternative: Text des Word-Range-Opjektes direkt in Excelzelle einfügen.
          .Cells(letztezeile, 2) = wdRange.Text
Weiter03:
      End If
    End With 'wks
    
    'Worddatei wieder schliessen
    objDoc.Close savechanges:=False
    strFileName = Dir
    
  Loop
  
  'Word-Anwendung beenden
  objWDApp.Quit

Beenden:
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "bestimmte Zeilen aus Word-Datei auslesen"