Guten Tag,

Ich habe ein Word Dokument das während des Speichervorgangs Inhalte an eine Excel Tabelle überträgt. Die Excel Tabelle ist dafür geschlossen und wird dann von Word über ein Macro selbst aufgerufen. Die Daten werden an die Excel Tabelle übergeben, gespeichert und die Tabelle wird wieder geschlossen.

Nun ist es jedoch so, das manche Benutzer diese Tabelle auch mal manuell öffnen und vergessen diese wieder zu schließen. Wenn nun das Macro für die Datenübertragung stattfindet, wird eine zweite (Schreibgeschützte Instanz) dieser Tabelle geöffnet, die logischerweise nicht gespeichert werden kann weil das Original noch geöffnet ist.

Ich suche nach einem Weg dem Macro aufzutragen bevor es die Excel Tabelle öffnet, erst einmal zu überprüfen ob diese bereits offen ist. Falls ja soll diese geschlossen werden und danach soll erst der eigentliche Ablauf fortgesetzt werden (Excel öffnen, Daten übergeben, Excel speichern und schließen).

Ich poste mal den Code mit dem ich es bisher versucht habe, der leider nicht funktioniert. Eventuell hat jemand eine andere Lösung.

'Hier soll geprüft werden ob die Excel Mappe bereits geöffnet ist.

Sub ExcelMapCheckIfOpen()
    Dim xlApp As Object
    Dim xlWBook As Object
    On Error Resume Next
    Set xlApp = CreateObject("excel.Application")
    Set xlWBook = xlApp.Workbooks(ThisDocument.Path & "\artexGeräteliste.xlsx")
    On Error GoTo 0
    If Not xlWBook Is Nothing Then xlWBook.Close False
End Sub


'Hier findet die eigentliche Datenübertragung statt.

Sub DataTransfer(sID As String)
    Dim xlApp As Object
    Dim xlWBook As Object
    Dim fld As FormField
    Dim nRow As Long
    Dim nCol As Integer
    Dim ws As Object
    Dim lfdNr As Long
    Dim NextID As Long
    Dim nInstall As String
    Dim nTech As String, nEqui As String, nTyp As String, nPTB As String, nSNR As String, nSA As String
    Dim nFDSS As String, nEXGRP As String, nBetriebsdruck As String, nBetriebstemp As String, nEinbaulage As String
    Dim nWRKR As String, nFFA As String, nPMBAR As String, nVMBAR As String, nPVDTNG As String, nVVDTNG As String
    Dim nMWRKST As String, nMedium As String, nHeizung As String, nIsolierung As String, nAccess As String
    Dim nrow1 As Long

    Const xlUp = -4162
     
    Application.ScreenUpdating = False
     
    Set xlApp = CreateObject("excel.Application")
    Set xlWBook = xlApp.Workbooks.Open(ThisDocument.Path & "\artexGeräteliste.xlsx")
    xlWBook.Application.Visible = True
    xlWBook.Application.Sheets("Tankschutzarmaturen").Select
    Set ws = xlWBook.Sheets("Tankschutzarmaturen")
    If sID = "0" Then
    nRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row + 1
    NextID = xlApp.WorksheetFunction.Max(ws.Range("A:A")) + 1
    ws.Cells(nRow, 1) = NextID
    ActiveDocument.Variables("lfdNr").Value = NextID
    ActiveDocument.Save
    Else
        On Error Resume Next
        nRow = xlApp.WorksheetFunction.Match(CLng(sID), ws.Range("A:A"), 0)
        If nRow = 0 Then nRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row + 1
        On Error GoTo 0
    End If
...
...
...

Hat jemand eine Idee wie man das verwirklichen kann?

Gruß

Manuel