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
|