Microsoft Excel

Herbers Excel/VBA-Archiv

Word-Datei zeilenweise einlesen und speichern


Betrifft: Word-Datei zeilenweise einlesen und speichern
von: Dre
Geschrieben am: 12.08.2017 15:42:52

Hallo leibe VBA-Community,

ich versuche seit Tage folgende Aufgabe zu lösen:

Eine Word-Datei soll zeilenweise eingelesen werden, dabei wäre es cool, wenn die Zeileninhalte in ein String-Array (aber alternativ auch in Zellen einer Excel-Tabelle, Zeile pro Zelle) gespeichert werden.

Vielen Dank im Voraus für Eure Hilfe!

Viele Grüße,
Dre

  

Betrifft: AW: Word-Datei zeilenweise einlesen und speichern
von: Sepp
Geschrieben am: 12.08.2017 16:24:09

Hallo Dre,

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub inputWordFile()
Dim strFile As String, lngI As Long, objWord As Object, strText() As String, strTmp As String

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "C:\"
  .Title = "Datei auswählen"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  .Filters.Clear
  .Filters.Add "Word Dateien", "*.doc; *.doc*", 1
  .FilterIndex = 1
  If .Show = -1 Then strFile = .SelectedItems(1)
End With

If Len(strFile) Then
  Set objWord = CreateObject("Word.Application")
  
  With objWord
    .Visible = False
    .Documents.Open strFile, , True
    .WordBasic.EditSelectAll
    .WordBasic.SetDocumentVar "MyVar", .WordBasic.Selection
    strTmp = .WordBasic.GetDocumentVar("MyVar")
    .Documents.Close (0)
    .Quit
  End With
  
  strText = Split(strTmp, vbCr)
  
  'Der Text befindet sich nun im Array strText
  
  'Ausgabe in Zellen
  Sheets("Tabelle1").Range("A1").Resize(UBound(strText) + 1, 1) = Application.Transpose(strText)
End If


Set objWord = Nothing
End Sub


Gruß Sepp



  

Betrifft: AW: Word-Datei zeilenweise einlesen und speichern
von: Luschi
Geschrieben am: 12.08.2017 16:54:21

Hallo Sepp,

beim Testen Deines Tipps mit Word 2016 kommt hier ein Fehler:
.Documents.Open strFile, , True
Deshalb habe ich eine kleine Änderung eingebaut:

Sub inputWordFile()
    Dim objWord As Object, objDoc As Object
    Dim strFile As String, lngI As Long, strText() As String, strTmp As String
    
    With Application.FileDialog(msoFileDialogFilePicker)
      .InitialFileName = "F:\Daten\Downloads\"
      .Title = "Datei auswählen"
      .ButtonName = "Auswahl..."
      .InitialView = msoFileDialogViewList
      .Filters.Clear
      .Filters.Add "Word Dateien", "*.doc; *.doc*", 1
      .FilterIndex = 1
      If .Show = -1 Then strFile = .SelectedItems(1)
    End With
    
    If Len(strFile) Then
      Set objWord = CreateObject("Word.Application")
      
      With objWord
        .Visible = False
        ''Worddatei schreiabgeschützt öffnen
        ''statt
        ''.Documents.Open strFile, , True
        Set objDoc = .Documents.Open(strFile, , True)
        .WordBasic.EditSelectAll
        .WordBasic.SetDocumentVar "MyVar", .WordBasic.Selection
        strTmp = .WordBasic.GetDocumentVar("MyVar")
        'Fehler 4605 - Befehl im Lesemodus nicht verfügbar
        '.Documents.Close (0)
        objDoc.Close False
        .Quit
      End With
      
      strText = Split(strTmp, vbCr)
      
      'Der Text befindet sich nun im Array strText
      'Ausgabe in Zellen
      Sheets("Tabelle1").Range("A1").Resize(UBound(strText) + 1, 1) = Application.Transpose( _
strText)
    End If
    
    Set objWord = Nothing: Set objDoc = Nothing
End Sub
Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Word-Datei zeilenweise einlesen und speichern
von: Sepp
Geschrieben am: 12.08.2017 16:59:53

Hallo Luschi,

komisch, bei mir (ebenfalls Office 2016) läuft es ohne Probleme.

Gruß Sepp



  

Betrifft: AW: Word-Datei zeilenweise einlesen und speichern
von: Luschi
Geschrieben am: 12.08.2017 17:08:32

Hallo Sepp,

finde ich auch komisch, hoffentlich liegt es nicht an der verwendeten Windows-Version!


Gruß von Luschi
aus klein-Paris





  

Betrifft: Neue Version
von: Sepp
Geschrieben am: 12.08.2017 17:58:40

Hallo Luschi,

diese Version sollte auf allen Versionen laufen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub inputWordFile()
Dim strFile As String, strText() As String, strTmp As String

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "C:\"
  .Title = "Datei auswählen"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  .Filters.Clear
  .Filters.Add "Word Dateien", "*.doc; *.doc*", 1
  .FilterIndex = 1
  If .Show = -1 Then strFile = .SelectedItems(1)
End With

If Len(strFile) Then
  strTmp = getWordDocText(strFile)
  
  strText = Split(strTmp, vbCr)
  
  'Der Text befindet sich nun im Array strText
  
  'Ausgabe in Zellen
  Sheets("Tabelle1").Range("A1").Resize(UBound(strText) + 1, 1) = Application.Transpose(strText)
End If

End Sub

Private Function getWordDocText(ByVal FileName As String, Optional includeHeader As Boolean = False, Optional includeFooter As Boolean = False) As String
Dim objWord As Object, objDoc As Object
Dim strHeader As String, strFooter As String, strContent As String

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(FileName)

strHeader = objDoc.Sections(1).Headers(1).Range.Text

strFooter = objDoc.Sections(1).Footers(1).Range.Text

strContent = objDoc.Content

If includeHeader Then strContent = strHeader & vbNewLine & strContent
If includeFooter Then strContent = strContent & vbNewLine & strFooter

getWordDocText = strContent

objDoc.Close
objWord.Quit
Set objDoc = Nothing
Set objWord = Nothing
End Function


Gruß Sepp



  

Betrifft: AW: Neue Version
von: Luschi
Geschrieben am: 12.08.2017 19:07:38

Hallo Sepp,

in Word 2013/16 läuft Deine neue Version bestens.

Gruß von Luschi
aus klein-Paris