Option Explicit Public Sub Main() Dim objTable As Object Dim objWDApp As Object Dim objWDDoc As Object Dim objRow As Object On Error GoTo Fin Set objWDApp = OffApp("Word") If Not objWDApp Is Nothing Then Set objWDDoc = objWDApp.Documents.Open _ (ThisWorkbook.Path & Application.PathSeparator & "Doc1.doc") Set objTable = objWDDoc.Tables(1) With objTable Debug.Print .Rows.Count .Rows.Add ' Am Ende Zeile einfuegen Set objRow = .Rows.Add(BeforeRow:=.Rows(3)) Debug.Print .Rows.Count End With End If Fin: Set objRow = Nothing Set objTable = Nothing Set objWDDoc = Nothing Set objWDApp = Nothing If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & " " & Err.Description End Sub Private Function OffApp(ByVal strApp As String) 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") objApp.Visible = True If Err.Number > 0 Then MsgBox Err.Number & " " & Err.Description Set objApp = Nothing End If Case 0 Case Else MsgBox Err.Number & " " & Err.Description Set objApp = Nothing End Select On Error GoTo 0 Set OffApp = objApp Set objApp = Nothing End Function
Hier noch ein Beispiel mit Worddatei: Sample