Microsoft Excel

Herbers Excel/VBA-Archiv

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

Ersten Eintrag in Word-VBA auslesen

Betrifft: Ersten Eintrag in Word-VBA auslesen von: Peter
Geschrieben am: 14.08.2020 17:41:09

Hallo,
ich komme leider nicht weiter.

Ich öffne mit nachstehendem Makro eine Worddatei.

Ich möchte den Ersten Eintrag auslesen. Bitte helft mir:

Sub Word_Dokument_bearbeiten2a()
  Dim aktuellerpfad As String
  Dim alterpfad As String
  Dim ErsetzeDurch As String
  Dim objWordApp As Object
  Dim objWDDoc As Object
  Dim Pfad As String
  Dim SucheNach As String
  Dim xRange As Object 'benötigt für Durchlauf der Zeilen im Dokument
  Dim xFiled As Object 'benötigt für die Felder im Dokument
  
  
Dim wdDoc As String

wdDoc = Worksheets("Tabelle3").Range("A1").Value
Debug.Print wdDoc
  
  Set objWordApp = CreateObject("Word.Application")
  objWordApp.Visible = True
  
''  Set objWDDoc = objWordApp.Documents.Open("C:\Users\Peter\Desktop\TestPeterNeu02\Dok02 -  _
Kopie.docm")
  Set objWDDoc = objWordApp.Documents.Open(wdDoc)
  
    objWDDoc.ActiveWindow.View.ShowFieldCodes = True    'Word-VBA öffnen
  
'hier ersten Eintrag auswählen und auslesen

  
objWDDoc.ActiveWindow.View.ShowFieldCodes = False    'Word-VBA schliessen
  
  objWDDoc.Close SaveChanges:=True
  objWordApp.Quit
  Set objWDDoc = Nothing
End Sub

Betrifft: Definiere EINTRAG! (owT)
von: EtoPHG
Geschrieben am: 14.08.2020 17:44:42



Betrifft: AW: Definiert
von: Peter
Geschrieben am: 15.08.2020 08:37:01

Hallo,
in dem von mir angezeigten Code ist auskommentiert: hier ersten Eintrag auswählen und auslesen.

An dieser Stelle möchte ich aus dem Link den Pfad und Dateiname in Anführungszeichen auslesen.
Es handelt sich hierbei z. B. um folgenden Link:

LINKExcel.SheetMacroEnabled.12 „C:\\Users\\Peter\\Desktop\\TestPeterNeu03\\Mappe02.xlsm“
"Tabelle1!Z6S2" \a \t

Dieser Teil soll ausgelesen werden und in Tabelle3.range("C5") übertragen werden.

Besten Dank

Gruss
Peter

Betrifft: AW: Ersten Eintrag in Word-VBA auslesen
von: Oberschlumpf
Geschrieben am: 15.08.2020 09:24:37

Hi Peter,

wieso macht ihr es euch nur immer wieder schwerer, als es (meiner Meinung nach) sein muss?

Du zeigst uns n bisschen Code.
Du beschreibst eher vage, als ganz genau, was du erreichen willst.
Du zeigst uns aber nicht! per Upload Bsp-Dateien, z Bsp ne Word-Datei (wenn doc* als Download nicht erlaubt, dann diese in eine ZIP-Datei "einpacken")

Wir sehen nicht! auf deinen Computer - wir sehen nicht! deine Dateien/deren Inhalte.

Ciao
Thorsten

ach ja...wenn du per Upload ne Bsp-Datei zeigst, wäre es schön, wenn diese auch so einen Link enthält und andere Texte, so dass wir erkennen können, was du erreichen möchtest....glaub mir, hier wurden auch schon leere! Bsp-Dateien per Upload gezeigt.

Betrifft: AW: Datei anbei
von: Peter
Geschrieben am: 15.08.2020 11:26:53

Hallo Thorsten,
es handelt sich um Modul7.

Datei anbei:https://www.herber.de/bbs/user/139647.zip

Gruss
Peter

Betrifft: AW: MOF: Python
von: Fennek
Geschrieben am: 15.08.2020 11:44:59

Hallo,

die Frage steht auch in MOF.

Hier eine Lösung mit Python:
C:\Temp\Python\OLEDump>zipdump.py c:\Users\User\Desktop\139647.zip -s 1 -d | zipdump.py
Index Filename                     Encrypted Timestamp
    1 [Content_Types].xml                  0 1980-01-01 00:00:00
    2 _rels/.rels                          0 1980-01-01 00:00:00
    3 word/_rels/document.xml.rels         0 1980-01-01 00:00:00
    4 word/document.xml                    0 1980-01-01 00:00:00
    5 word/theme/theme1.xml                0 1980-01-01 00:00:00
    6 word/settings.xml                    0 1980-01-01 00:00:00
    7 word/fontTable.xml                   0 1980-01-01 00:00:00
    8 word/webSettings.xml                 0 1980-01-01 00:00:00
    9 docProps/app.xml                     0 1980-01-01 00:00:00
   10 docProps/core.xml                    0 1980-01-01 00:00:00
   11 word/styles.xml                      0 1980-01-01 00:00:00

C:\Temp\Python\OLEDump>zipdump.py c:\Users\User\Desktop\139647.zip -s 1 -d | zipdump.py -s 4 -d

 LINK Excel.SheetMacroEnabled.12 C:\\Users\\Peter\\Desktop\\TestPeterNeu01\\Mappe01.xlsm Tabelle1!Z1S1 \a \t Test22 LINK Excel.SheetMacroEnabled.12 C:\\Users\\Peter\\Desktop\\TestPeterNeu01\\Mappe01.xlsm Tabelle1!Z2S1 \a \t Test23 LINK Excel.SheetMacroEnabled.12 C:\\Users\\Peter\\Desktop\\TestPeterNeu01\\Mappe01.xlsm Tabelle1!Z3S1 \a \t Test24 LINK Excel.SheetMacroEnabled.12 C:\\Users\\Peter\\Desktop\\TestPeterNeu01\\Mappe01.xlsm Tabelle1!Z4S1 \a \t Test25 LINK Excel.SheetMacroEnabled.12 C:\\Users\\Peter\\Desktop\\TestPeterNeu01\\Mappe01.xlsm Tabelle1!Z5S1 \a \t Test26


Betrifft: AW: MOF: Python
von: Peter
Geschrieben am: 15.08.2020 11:50:33

Hallo Fennek,
ich habe gerade den Hinweis in MOF gelesen. Ich kapiere jedoch die benannte Lösung nicht.

Jedoch habe ich in meinem Fundus etwas gefunden, welche die gesamten Links übertragen.
Sub FernsteuerungWord_auslesen()
Dim AppWord As Object, WordDokument As String, SucheNach As String, ErsetzeDurch As String
Dim varText 'benötigt für Auswahl gesamter Text

Application.ScreenUpdating = False

With Worksheets("Tabelle3")
WordDokument = .Cells(2, 1) 'A2
End With


Set AppWord = CreateObject("Word.application")

With AppWord
.Visible = True
.WindowState = xlMaximized
.Documents.Open WordDokument ' Name der Worddaten

'hier kommt dein aufgezeichnetes Dings (leicht abgewandelt)

 Application.ScreenUpdating = False


If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
.ActiveWindow.ActivePane.View.Type = 1 'wdNormalView
Else
.ActiveWindow.View.Type = 1 '.wdNormalView
End If

.ActiveWindow.View.ShowFieldCodes = True

'hier einfügen was gemacht werden soll
With AppWord
.Selection.WholeStory   'wählt alles aus
varText = .Selection
''Cells(Rows.Count, 3).End(xlUp).Offset(1, 2) = varText
Worksheets("Tabelle3").Range("E5") = varText

End With


.ActiveWindow.View.ShowFieldCodes = False
If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
.ActiveWindow.ActivePane.View.Type = 3
Else
.ActiveWindow.View.Type = 3 'wdPrintView
End If

Application.ScreenUpdating = True


'Worddokument mit speichern schliessen
AppWord.Documents.Close True

If AppWord.Documents.Count = 0 Then
AppWord.Quit
End If

End With
ThisWorkbook.Activate
Set AppWord = Nothing
End Sub
Kannst Du mir diesen Code eventuell so abändern, dass nicht ".Selection.WholeStory 'wählt alles aus"
ausgewählt wird sondern nur der erste Eintrag. Dann würde dies soweit gelingen.

Gruss
Peter

Betrifft: AW: VBA in xlsm
von: Fennek
Geschrieben am: 15.08.2020 12:00:19

Hallo,

im Moment bin ich noch mit der Analyse deiner Dateien beschäftigt:

In der xlsm scheinen mehrfach ähnliche Code (von Gerhard?) zu stehen:
C:\Temp\Python\OLEDump>zipdump.py c:\Users\User\Desktop\139647.zip -s 2 -d | oledump.py
A: xl/vbaProject.bin
 A1:       792 'PROJECT'
 A2:       266 'PROJECTwm'
 A3: m    1181 'VBA/DieseArbeitsmappe'
 A4: m    2506 'VBA/Modul1'
 A5: M   21822 'VBA/Modul3'
 A6: M   21324 'VBA/Modul3_Gerhard'
 A7: M   12927 'VBA/Modul4'
 A8: M    3326 'VBA/Modul7'
 A9: m    1145 'VBA/Tabelle1'
A10: m    1025 'VBA/Tabelle2'
A11: m    1190 'VBA/Tabelle3'
A12:      8215 'VBA/_VBA_PROJECT'
A13:      3558 'VBA/__SRP_0'
A14:       238 'VBA/__SRP_1'
A15:       432 'VBA/__SRP_4'
A16:       106 'VBA/__SRP_5'
A17:       828 'VBA/dir'
In jedem Fall erscheint mit (auf einen ersten Blick) der Ansatz als viel zu kompliziert.

Betrifft: AW: VBA in xlsm
von: Peter
Geschrieben am: 15.08.2020 13:26:59

Hallo Fennek,
besten Dank für Deine Antwort. Es wäre natürlich toll wenn es eine einfachere Lösung geben würde.
Noch als kleiner Hinweis: Es können auch mehrere Worddokumente vorhanden sein.

Freue mich auf eine Antwort von Dir.

Gruss
Peter

Betrifft: AW: VBA in xlsm
von: Matthias
Geschrieben am: 19.08.2020 19:26:30

Moin!
Da lange keine Ergänzung kam, hätte ich noch was zu Ergänzung. Du hattest mal einen Code gepostet, der alles auslist. Hier mal eine Anpassung, die alles ausliest und dann aufsplittet und nur den ersten Teil einträgt. Damit könntest du dann auch die anderen Einträge durchlaufen (beim split den INdex ändern)
Sub FernsteuerungWord_auslesen()
  Dim AppWord As Object, WordDokument As String, SucheNach As String, ErsetzeDurch As String
  Dim varText 'benötigt für Auswahl gesamter Text
  
  Application.ScreenUpdating = False
  
  With Worksheets("Tabelle3")
  WordDokument = .Cells(2, 1) 'A2
  End With
  
  
  Set AppWord = CreateObject("Word.application")
  
  With AppWord
  .Visible = True
  .WindowState = xlMaximized
  .Documents.Open WordDokument ' Name der Worddaten
  
  'hier kommt dein aufgezeichnetes Dings (leicht abgewandelt)
  
   Application.ScreenUpdating = False
  
  
  If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
  .ActiveWindow.ActivePane.View.Type = 1 'wdNormalView
  Else
  .ActiveWindow.View.Type = 1 '.wdNormalView
  End If
  
  .ActiveWindow.View.ShowFieldCodes = True
  
  'hier einfügen was gemacht werden soll
  With AppWord
  .Selection.WholeStory   'wählt alles aus
  varText = .Selection
  ''Cells(Rows.Count, 3).End(xlUp).Offset(1, 2) = varText
  Worksheets("Tabelle3").Range("E5") = VBA.Chr(19) & Split(varText, VBA.Chr(19))(1)
  
  End With
  
  
  .ActiveWindow.View.ShowFieldCodes = False
  If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
  .ActiveWindow.ActivePane.View.Type = 3
  Else
  .ActiveWindow.View.Type = 3 'wdPrintView
  End If
  
  Application.ScreenUpdating = True
  
  
  'Worddokument mit speichern schliessen
  AppWord.Documents.Close True
  
  If AppWord.Documents.Count = 0 Then
  AppWord.Quit
  End If
  
  End With
  ThisWorkbook.Activate
  Set AppWord = Nothing
  End Sub
VG

Betrifft: AW: VBA in xlsm
von: Peter
Geschrieben am: 19.08.2020 19:57:54

Hallo Matthias,
besten Dank für Deine Hilfe. Ich habe jetzt eine Lösung gefunden, die einwandfrei funktioniert.

Es wird aus dem ersten Worddokument der vorhandene Pfad und Name ausgelesen, dann wird geprüft, ob dieser mit den Daten aus dem geöffneten Programm identisch ist. Identisch = exit Sub. Nicht identisch werden alle Dokumente ersetzt mit neuem Namen.
Sub Prüfung_bzw_Änderung_der_Worddokumente()  'damit Spalte E nicht erforderlich
    Dim wb As Workbook                  'benötigt für Workbook
    Dim wsWd As Worksheet                'benötigt für Worksheet Worddaten
    Dim iRow As Long, iLastRow As Long  'benötigt für Durchlaufen der Worddokumente
    Dim strWert As String               'benötigt für Auslesen Pfad Name erste Worddokument
    Dim strWert2 As String              'benötigt für Durchlaufen der Worddokumente
    Dim strPfad As String               'benötigt für Auslesen Pfad Name erste Worddokument und  _
Durchlaufen der Worddokumente
    Dim objWordApp As Object            'benötigt für öffnen Word
    Dim objWDDoc As Object              'benötigt für öffnen Worddokument
    Dim wdDoc As String                 'benötigt für Auswahl Name des Worddokuments aus der  _
Tabelle3
    Dim varText As String               'benötigt für Auslesen von Code aus Worddokument
    Dim SucheNach As String             'benötigt für den Suchbegriff aus dem Worddokuments
    Dim ErsetzeDurch As String          'benötigt für den ErsetzeDurch = Wert der aktuellen  _
Datei
    
    Application.ScreenUpdating = False
   
    Set wb = ThisWorkbook
    Set wsWd = wb.Worksheets("Worddaten")
    
    
    With wsWd
        strPfad = .Range("B46").Value
        strWert = strPfad & .Cells(2, 3).Value   'strWert = der gültige Pfad und das  _
Worddokument
        'Debug.Print strWert
    
        'Anfang - Worddokument Pfad übertragen
        wdDoc = strWert 'strWert = der gültige Pfad und das Worddokument
        Set objWordApp = GetObject(wdDoc)   'damit wird Worddokument nicht sichtbar geöffnet( _
nur scheinbar geöffnet)
      
        'Anfang ersten Eintrag auswählen und auslesen
        With objWordApp
            varText = .Fields(1).Code   'Code aus dem 1. Feld aus geöffnetem Worddokument
            varText = Mid(varText, InStr(1, varText, ":") - 1, InStr(1, varText, ".xlsm") + 6 -  _
InStr(1, varText, ":")) 'Umwandlung nur Teil aus dem Code
        End With
        'Ende ersten Eintrag auswählen und auslesen
            .Range("B44") = """" & varText & """"   'hinzufügen von Anführungszeichen vor und  _
nach dem ausgelesenen Code
    End With        'End With für wsTB3

        objWordApp.Close SaveChanges:=True
        Set objWDDoc = Nothing
        'Ende - Worddokument Pfad übertragen
    
    
'Anfang alle Worddokumente ändern
    With wsWd
        SucheNach = .Range("B44").Value
        'Debug.Print SucheNach
        ErsetzeDurch = .Range("B42").Value
        'Debug.Print ErsetzeDurch
    
                'Prüfung - ob  identisch
                'nicht identisch mit Abbruch
                If ErsetzeDurch = SucheNach Then
                    MsgBox "beide Werte gleich = Abbruch"
                    Application.ScreenUpdating = True
                    Exit Sub
                'identisch Fortsetzung des Makro
                ElseIf ErsetzeDurch <> SucheNach Then
                    MsgBox "beide Werte nicht gleich = Makro"
    
    
                Set objWordApp = CreateObject("Word.Application")
                'objWordApp.Visible = True
                objWordApp.Visible = False
    
    
        iLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        strPfad = .Range("B46").Value
        
        For iRow = 2 To iLastRow
        
            If .Cells(iRow, 3).Value <> Empty Then          'nur die nicht leeren Zellen werden  _
ausgelesen
                strWert2 = strPfad & .Cells(iRow, 3).Value   'strWert = der gültige Pfad und  _
das Worddokument
                'Debug.Print strWert2
                        
                Set objWDDoc = objWordApp.Documents.Open(strWert2)
            
                objWDDoc.ActiveWindow.View.ShowFieldCodes = True    'Word-VBA öffnen
            
                'Anfang alles umwandeln
                objWordApp.Selection.Find.ClearFormatting
                objWordApp.Selection.Find.Replacement.ClearFormatting
                objWordApp.Selection.Find.Execute FindText:=SucheNach, ReplaceWith:= _
ErsetzeDurch, Replace:=2   'Fehler
                'Ende alles umwandeln
            
                objWDDoc.ActiveWindow.View.ShowFieldCodes = False    'Word-VBA schliessen
                
            End If
        'Ende - ob identisch
        
            Application.ScreenUpdating = True
                
            objWDDoc.Close SaveChanges:=True
                        
        Next    'für For
        
                End If
        
            objWordApp.Quit
            Set objWDDoc = Nothing
        
    End With    'End With für TB3
'Ende alle Worddokumente ändern
End Sub
Es existieren jetzt kleine Änderungen bezüglich Bezug der Daten.

Gruss
Peter

Betrifft: AW: Lösung gefunden
von: Peter
Geschrieben am: 15.08.2020 12:09:32

Hallo Fennek,

ich habe jetzt die Lösung gefunden:
Sub FernsteuerungWord_auslesen2()
Dim AppWord As Object, WordDokument As String, SucheNach As String, ErsetzeDurch As String
Dim varText 'benötigt für Auswahl gesamter Text

Application.ScreenUpdating = False

With Worksheets("Tabelle3")
WordDokument = .Cells(2, 1) 'A2
End With


Set AppWord = CreateObject("Word.application")

With AppWord
.Visible = True
.WindowState = xlMaximized
.Documents.Open WordDokument ' Name der Worddaten


 Application.ScreenUpdating = False


If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
.ActiveWindow.ActivePane.View.Type = 1 'wdNormalView
Else
.ActiveWindow.View.Type = 1 '.wdNormalView
End If

.ActiveWindow.View.ShowFieldCodes = True

'hier einfügen was gemacht werden soll
With AppWord
    .Selection.WholeStory   'wählt alles aus
    varText = .Selection
    
    varText = Mid(varText, InStr(1, varText, ":") - 1, InStr(1, varText, ".xlsm") + 6 - InStr(1, _
 varText, ":"))
    
    Worksheets("Tabelle3").Range("E5") = "„" & varText & "“"
End With


.ActiveWindow.View.ShowFieldCodes = False
If .ActiveWindow.View.SplitSpecial = 0 Then 'wdPaneNone
.ActiveWindow.ActivePane.View.Type = 3
Else
.ActiveWindow.View.Type = 3 'wdPrintView
End If

Application.ScreenUpdating = True


'Worddokument mit speichern schliessen
AppWord.Documents.Close True

If AppWord.Documents.Count = 0 Then
AppWord.Quit
End If

End With
ThisWorkbook.Activate
Set AppWord = Nothing
End Sub
Wünsche noch ein schönes Wochenende.

Gruss
Peter

Beiträge aus dem Excel-Forum zum Thema "Ersten Eintrag in Word-VBA auslesen"