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
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
...
...
...