Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1680to1684
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

Zugriff auf Word-Daten

Zugriff auf Word-Daten
21.03.2019 20:30:57
Thomas
Hallo zusammen,
mit folgender Prozedur hole ich mir die für mich benötigten Informationen aus Worddateien, die _ sich in einem bestimmten Verzeichnis befinden.

Sub Import()
Dim nRow As Integer
Dim strVerzeichnis As String
Dim StrDatei As String
Dim StrTyp As String
Dim Dateiname As String
Dim oWord As Object
Dim szFooter As String
Application.ScreenUpdating = False
nRow = 1
Set oWord = CreateObject("word.application")
If IsNull(oWord) Then Exit Sub
strVerzeichnis = "C:\Temp\"
StrTyp = "*.docx"
Dateiname = Dir(strVerzeichnis & StrTyp)
Do While Dateiname  ""
oWord.documents.Open (strVerzeichnis & Dateiname)
szFooter = oWord.activedocument.sections(1).footers(1).Range.Text
Sheets(1).Cells(nRow, 1).Value = szFooter
oWord.activedocument.Close
Dateiname = Dir
nRow = nRow + 1
Loop
Application.ScreenUpdating = True
Set oWord = Nothing
End Sub
Dieses funktioniert, allerdings dauert es ziemlich lange. Jetzt nun meine Frage, gibt es hier noch eine Optimierungsmöglichkeit oder andere Vorgehensweise diese Daten auszulesen. Vielleicht ohne die Dateien zu öffnen?
Vielen Dank für jeden Tipp und Eure Hilfe.
Gruß
Thomas

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zugriff auf Word-Daten
22.03.2019 08:42:39
Nepumuk
Hallo Thomas,
ich sehe da kaum Optimierungsmöglichkeiten. Und nein, ohne öffnen geht das nicht.
Public Sub Import()
    
    Dim nRow As Long
    Dim strVerzeichnis As String
    Dim Dateiname As String
    Dim oWord As Object
    Dim oDocument As Object
    Dim szFooter As String
    
    Application.ScreenUpdating = False
    nRow = 1
    Set oWord = CreateObject("word.application")
    strVerzeichnis = "C:\Temp\"
    Dateiname = Dir$(strVerzeichnis & "*.docx")
    Do Until Dateiname = ""
        
        Set oDocument = oWord.documents.Open(strVerzeichnis & Dateiname)
        Worksheets(1).Cells(nRow, 1).Value = oDocument.sections(1).footers(1).Range.Text
        
        oDocument.Close
        Dateiname = Dir$
        nRow = nRow + 1
    Loop
    Application.ScreenUpdating = True
    
    oWord.Quit
    
    Set oDocument = Nothing
    Set oWord = Nothing
End Sub

Gruß
Nepumuk
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige