Hilfe erbeten - Laufzeitfehler 462
21.02.2018 13:38:47
SanMiguel
Zunächst vielen Dank für eure Beiträge die Community hilft ungemein.
Zu meinem Problem:
Ich versuche gerade einen Algorithmus zu schreiben der Inhalte aus Tabellen in bestehenden Worddokumenten (ohne Formularformatierungen) in eine Exceltabelle kopiert.Genauer gesagt:
1. Prüfen letzte Dateiendung in Exceltabelle
2. Öffnen nächstes Wordokument wenn vorhanden ansonsten weiter mit übernächster nummer
3. Kopieren der Inhalte und einfügen in Excelliste
4. Worddokument ohne speichern schließen
Nächster schritt soll eine Schleife sein um alle Dokumente im Ordner abzuarbeiten
Ich bekomme leider immer beim 2. Durchlauf des Algorithmus die Fehlermeldung Laufzeitfehler 462: Der Remote-Server-Computer existiert nicht oder ist nicht verfügbar
Habe schon Viele Foren, Google usw. durchsucht, komme aber leider nicht auf die Lösung. Am Algorithmus seht ihr, dass ich auch schon verschiedene Varianten ausprobiert habe das Worddokument einzubinden.
Zu meinen Skills außer einem Semester Informatik Grundlagen ist der Rest durch Youtube und Recherche entstanden, daher seht mir bitte die Nichtbeachtung von formalen Regeln nach.
Über Hilfe würde ich mich sehr freuen vielen Dank schon einmal!
Anbei der Algorithmus:
Public Sub letzte_zelle_1()
Dim exlDatei As String
'Dim wrdDatei As String
Dim letztezelle As String
Dim naechsteDatei As String
Dim dateiEnd As String
Dim Dateinmame As String
Dim Pfad As String
Dim Filename As String
'Dim wordApp As Object
'Dim wordDoc As Object
Dim Kopie_Pruefdatum As String
Dim Kopie_Maschine As String
Dim Kopie_Abteilung As String
Dim Kopie_Hersteller As String
Dim Kopie_MaschNr As String
'Dim Kopie5 As String
exlDatei = ActiveWorkbook.Name
letztezelle = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'letzte Zelle in _
Datumsspalte finden
'Worksheets("Sheet1").Cells(25, 8).Value
naechsteDatei = Worksheets("Tabelle1").Cells(letztezelle + 1, 2).Value
sprungziel:
dateiEnd = Right(naechsteDatei, 4)
'MsgBox dateiEnd
Pfad = "U:\Eigene Dateien\Projekt Kern u Liebers\Noch nicht in der Tabelle\"
Dateinmame = Dir(Pfad & "*" & dateiEnd & ".docx")
' MsgBox Dateinmame
If Dateinmame "" Then
Dim WordApp As Word.Application
' Dim WordDatei As Word.Document
Set WordApp = New Word.Application
With WordApp
.Visible = True
.Documents.Open Filename:="U:\Eigene Dateien\Projekt Kern u Liebers\Noch nicht in der _
_
Tabelle\" & Dateinmame
End With
' Set WordDatei = WordApp.Documents.Add
' Set wordApp = CreateObject("word.application")
'' Set wordApp = CreateObject("word.document.14.0.7190.5000")
' Set wordDoc = wordApp.Documents.Open(Filename:="U:\Eigene Dateien\Projekt Kern u _
Liebers\Noch nicht in der Tabelle\" & Dateinmame)
' wordApp.Visible = True
Else
naechsteDatei = Worksheets("Tabelle1").Cells(letztezelle + 2, 2).Value
letztezelle = letztezelle + 1
GoTo sprungziel
End If
'wrdDatei = ActiveDocument.Name
'MsgBox wrdDatei
'Dim intCount As Integer 'Tabellen Zählen
'intCount = ActiveDocument.Tables.Count
'MsgBox intCount
Kopie_Pruefdatum = ActiveDocument.Tables(1).Cell(3, 2).Range.Text
Kopie_Pruefdatum = Right(Kopie_Pruefdatum, 13)
Kopie_Pruefdatum = Left(Kopie_Pruefdatum, Len(Kopie_Pruefdatum) - 1)
Kopie_Maschine = ActiveDocument.Tables(2).Cell(1, 2).Range.Text
Kopie_Maschine = Left(Kopie_Maschine, Len(Kopie_Maschine) - 1)
Kopie_Abteilung = ActiveDocument.Tables(2).Cell(2, 2).Range.Text
Kopie_Abteilung = Left(Kopie_Abteilung, Len(Kopie_Abteilung) - 1)
Kopie_Hersteller = ActiveDocument.Tables(3).Cell(1, 2).Range.Text
Kopie_Hersteller = Left(Kopie_Hersteller, Len(Kopie_Hersteller) - 1)
Kopie_MaschNr = ActiveDocument.Tables(3).Cell(3, 2).Range.Text
Kopie_MaschNr = Left(Kopie_MaschNr, Len(Kopie_MaschNr) - 1)
'Kopie5 = ActiveDocument.Tables(2).Cell(2, 4).Range.Text
'MsgBox Kopie
'MsgBox Kopie1
'MsgBox Kopie2
'MsgBox Kopie3
'MsgBox Kopie4
'ActiveDocument.Close_
' SaveChanges:=wdDoNotSaveChanges,
ActiveDocument.Close
WordApp.Quit
'Set WordApp = Nothing
'WordDatei.Close SaveChanges:=0
'WordApp.Quit
'Set WordDatei = Nothing
Set WordApp = Nothing
'wordDoc.Close SaveChanges:=0
'wordApp.Quit
'Set wordDoc = Nothing
'Set wordApp = Nothing
Windows(exlDatei).Activate
Sheets("Tabelle1").Select
Cells(letztezelle + 1, 3).Select
ActiveCell.FormulaR1C1 = Kopie_Pruefdatum
Cells(letztezelle + 1, 4).Select
ActiveCell.FormulaR1C1 = Kopie_Maschine
Cells(letztezelle + 1, 5).Select
ActiveCell.FormulaR1C1 = Kopie_Hersteller
Cells(letztezelle + 1, 6).Select
ActiveCell.FormulaR1C1 = Kopie_MaschNr
Cells(letztezelle + 1, 7).Select
ActiveCell.FormulaR1C1 = Kopie_Abteilung
'ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row = Kopie
End Sub
Anzeige