Microsoft Excel

Herbers Excel/VBA-Archiv

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

Letzte Zeile in Word abfragen | Herbers Excel-Forum


Betrifft: Letzte Zeile in Word abfragen von: Philipp
Geschrieben am: 16.02.2012 13:14:02

Ich bin grad dabei Werte von vielen Word Dateien nach Excel zu übertragen. Hab alles hinbekommen nur hab ich ein kleines Problem.

Datei:http://www.file-upload.net/download-4120729/SV-9016.doc.html

Auf der 2ten Seite könnt ihr sehen: Höhe und Datum.

Ich möchte nun immer den letzten Wert nach Excel transferieren. Wie geht das?

Mein bisheriger Code:

Option Explicit
Dim blnTMP As Boolean
Dim objApp As Object
Public Sub Main()
    Dim strPfad As String
    On Error GoTo Fin
    strPfad = "C:\Documents and Settings\geyerphi\Desktop\VERBINDUNG CHEMSERV\DATEN\"
    If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
    Set objApp = OffApp("Word")
    ActiveSheet.Range("B2:Z300").Clear
    If Not objApp Is Nothing Then
        'Columns("A:C").Clear
        'SearchFiles strPfad, "*.doc", False ' ohne Unterordner
        SearchFiles strPfad, "*.doc", True ' mit Unterordner
    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Sub SearchFiles(strFolder As String, strFileName As String, _
    Optional blnTMP As Boolean = False)

    Dim objDocument As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objFSO As Object
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.GetFolder(strFolder).Files
        If objFile.Name Like strFileName Then
           Set objDocument = objApp.Documents.Open _
                (objFile.Path)
                'Schreibgeschützte Word-Dateien werden entsperrt
                '(objApp.ActiveDocument.Unprotect)
               
                Dim OriginalProtection As WdProtectionType
                OriginalProtection = objApp.ActiveDocument.ProtectionType
                If OriginalProtection <> wdNoProtection Then objApp.ActiveDocument.Unprotect
                
                
                
            Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(2, 2).Range, _
                Chr(13) & Chr(7), ""), "", ""), Chr(13), "")
                
            'Ausgabe der Zeile Auftraggeber
            
            Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(3, 2).Range, _
                Chr(13) & Chr(7), "")
            'Ausgabe der Zeile Bestell - Nr- / WA - Nr.
            
            Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(4, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile SV-NR.
                
            Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(5, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Bau / Firma
                
            Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(6, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Einbauort
                
            Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(Replace(objDocument.Tables(1).Cell(7, 2).Range, _
                Chr(13) & Chr(7), ""), "/ - ° C", ""), "-", ""), Chr(9), "")
                'Ausgabe der Zeile Medium / Temperatur
                
            Range("H" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(13, 2).Range, _
                Chr(13) & Chr(7), ""), "mm", ""), Chr(9), "")
                'Ausgabe der Zeile Einstellhöhe
                
            Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
               Replace(Replace(Replace(objDocument.Tables(1).Cell(14, 2).Range, _
                Chr(13) & Chr(7), ""), "bar", ""), Chr(9), "")
                'Ausgabe der Zeile Einstelldruck
                
            Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(19, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Federnummer
                
            Range("K" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(20, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Bauteilkennzeichnung
                
            Range("L" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(objDocument.Tables(1).Cell(22, 2).Range, _
                Chr(13) & Chr(7), ""), "Ausflussziffer  (  W  ) -", "")
                'Ausgabe der Zeile Ausflussziffer
                
            Range("M" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(23, 1).Range, _
                Chr(13) & Chr(7), ""), "Hersteller:", ""), Chr(9), "")
                'Ausgabe der Zeile Hersteller
                
            Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(23, 2).Range, _
                Chr(13) & Chr(7), ""), "Figur : ", ""), Chr(13), "")
                'Ausgabe der Zeile Figur
                
            Range("O" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(objDocument.Tables(1).Cell(23, 3).Range, _
                Chr(13) & Chr(7), ""), "PN : ", "")
                 'Ausgabe der Zeile PN
                 
            Range("P" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(24, 1).Range, _
                Chr(13) & Chr(7), ""), "Eingang :", ""), Chr(9), "")
                'Ausgabe der Zeile Eingang
                
            Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(25, 1).Range, _
                Chr(13) & Chr(7), ""), "Ausgang :", ""), Chr(9), "")
                'Ausgabe der Zeile Ausgang
                
            Range("R" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(Replace(objDocument.Tables(1).Cell(26, 1).Range, _
                Chr(13) & Chr(7), ""), "Werkstoff :", ""), Chr(13), ""), Chr(9), "")
                 'Ausgabe der Zeile Werkstoff Werkstoff :
                 
            Range("S" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(26, 2).Range, _
                Chr(13) & Chr(7), ""), "Ventiltype :", ""), Chr(13), "")
                'Ausgabe der Zeile Ventiltype
                
            Range("T" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(27, 3).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Abnahme durch
                
            Range("U" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(objDocument.Tables(1).Cell(28, 1).Range, _
                Chr(13) & Chr(7), ""), "Datum :", "")
                'Ausgabe der Zeile Datum
                
            Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(31, 1).Range, _
                Chr(13) & Chr(7), ""), "Reparatur durchgeführt :", ""), Chr(9), "")
                'Ausgabe der Zeile Reperatur durchgeführt
                
            Range("W" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(Replace(Replace(objDocument.Tables(1).Cell(32, 1).Range, _
                Chr(13) & Chr(7), ""), "Datum :", ""), Chr(9), "")
                'Ausgabe der Zeile Datum
                
            Range("X" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(2).Cell(3, 2).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Höhe
                
            Range("Y" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(2).Cell(3, 3).Range, _
                Chr(13) & Chr(7), "")
                'Ausgabe der Zeile Datum
                
         
        
        
               
               
               
           objDocument.Close False
        End If
    Next objFile
    If blnTMP = True Then
        For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
            SearchFiles strFolder & "\" & objFolder.Name, strFileName, blnTMP
        Next objFolder
    End If
End Sub
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function


  

Betrifft: AW: Letzte Zeile in Word abfragen von: Case
Geschrieben am: 16.02.2012 20:43:07

Hallo, :-)

mit Crossposting schaffst Du dir hier keine Freunde. Und dass Du alles hinbekommen hast ist wohl etwas übertrieben. Noch viel Erfolg in Deinem Praktikum.

Servus
Case



Beiträge aus den Excel-Beispielen zum Thema "Letzte Zeile in Word abfragen"