Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1572to1576
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Word-Datei zeilenweise einlesen und speichern

Word-Datei zeilenweise einlesen und speichern
12.08.2017 15:42:52
Dre
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Word-Datei zeilenweise einlesen und speichern
12.08.2017 16:24:09
Sepp
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

Anzeige
AW: Word-Datei zeilenweise einlesen und speichern
12.08.2017 16:54:21
Luschi
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
Anzeige
AW: Word-Datei zeilenweise einlesen und speichern
12.08.2017 16:59:53
Sepp
Hallo Luschi,
komisch, bei mir (ebenfalls Office 2016) läuft es ohne Probleme.
Gruß Sepp

AW: Word-Datei zeilenweise einlesen und speichern
12.08.2017 17:08:32
Luschi
Hallo Sepp,
finde ich auch komisch, hoffentlich liegt es nicht an der verwendeten Windows-Version!
Userbild
Gruß von Luschi
aus klein-Paris
Neue Version
12.08.2017 17:58:40
Sepp
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

Anzeige
AW: Neue Version
12.08.2017 19:07:38
Luschi
Hallo Sepp,
in Word 2013/16 läuft Deine neue Version bestens.
Gruß von Luschi
aus klein-Paris

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige