Function GetWinLineDocInfoByAccountAndRunningNr(DocAccountAndRunningNr, PostingType, WinLineDocType) 'Stand 08.01.2021 On Error Resume Next 'Set SQL Table and Query for DocHead. Default: "T025" SQLTable_DocHead = "[T025]" SQLQuery_DocHead = "c000 = '" & DocAccountAndRunningNr & "'" & SQLQuery_OrderWhere 'Set SQL Table and Query for DocMid. Default: "T026" SQLTable_DocMid = "[T026]" SQLQuery_DocMid_MengeGeliefert = "" SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "SELECT SUM(c006) as [MengeGeliefert] " SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "FROM " & SQLTable_DocMid & "(NOLOCK) " SQLQuery_DocMid_MengeGeliefert = SQLQuery_DocMid_MengeGeliefert & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere SQLQuery_DocMid_Rueckstandsmenge = "" SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "SELECT SUM(c099) as [RueckstandsMenge] " SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "FROM " & SQLTable_DocMid & "(NOLOCK) " SQLQuery_DocMid_Rueckstandsmenge = SQLQuery_DocMid_Rueckstandsmenge & "WHERE [c000] LIKE '" & DocAccountAndRunningNr & "-%'" & SQLQuery_OrderWhere IF (SQLTable_DocHead <> "") and (SQLQuery_DocHead <> "") and (PostingType <> "") and (WinLineDocType <> "") Then Set SQLResult_DocHead = CWLStart.CurrentCompany.SearchRecord (SQLTable_DocHead, SQLQuery_DocHead) If Err.Number <> 0 Then MSGBOX "Error Code: "& Err.Number & vbCrlf & _ "Error Description: "& Err.Description,,"ERROR: Function GetWinLineDocInfoByAccountAndRunningNr Getting DocHead from DB Table "& SQLTable_DocHead Err.Clear Else 'If no line results If SQLResult_DocHead.RowCount = -1 Then If DebugMode = "Enabled" Then MSGBOX "No Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead End If Elseif SQLResult_DocHead.RowCount = 1 Then If DebugMode = "Enabled" Then MSGBOX "One Row found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table "& SQLTable_DocHead End If 'Unique Key DocAccountAndRunningNr = SQLResult_DocHead.value(0) 'Laufnumemr DocRunningNr = SQLResult_DocHead.value(21) 'Druckstatus Angebot / Anfrage DocPrintState1 = SQLResult_DocHead.value(22) 'Druckstatus Auftrag / Bestellung DocPrintState2 = SQLResult_DocHead.value(23) 'Druckstatus Lieferschein DocPrintState3 = SQLResult_DocHead.value(24) 'Druckstatus Rechnung DocPrintState4 = SQLResult_DocHead.value(25) 'Number of the Offer ("Angebot") DocOfferNr = SQLResult_DocHead.value(41) 'Number of the Order ("Angebot") DocOrderNr = SQLResult_DocHead.value(42) 'Number of delivery note ("Lieferschein") DocDeliveryNoteNr = SQLResult_DocHead.value(43) 'Number of the Invoice ("Rechung") DocInvoiceNr = SQLResult_DocHead.value(52) 'When the doc ("Beleg") was created DocCreated = SQLResult_DocHead.value(56) 'When the doc ("Beleg") was last changed DocLastChange = SQLResult_DocHead.value(57) 'The ten "Belegkopfnotizen" DocHeadText1 = SQLResult_DocHead.value(59) DocHeadText2 = SQLResult_DocHead.value(60) DocHeadText3 = SQLResult_DocHead.value(61) DocHeadText4 = SQLResult_DocHead.value(62) DocHeadText5 = SQLResult_DocHead.value(63) DocHeadText6 = SQLResult_DocHead.value(64) DocHeadText7 = SQLResult_DocHead.value(65) DocHeadText8 = SQLResult_DocHead.value(66) DocHeadText9 = SQLResult_DocHead.value(67) DocHeadText10 = SQLResult_DocHead.value(68) 'The current type (1= Anfrage/Angebot; 2= Auftrag/Bestellung; 3= Lieferschein; 4=Rechnung) DocType = SQLResult_DocHead.value(134) DocComment = SQLResult_DocHead.value(163) 'msgbox SQLQuery_DocMid_MengeGeliefert 'msgbox SQLQuery_DocMid_RueckstandsMenge Set SQLResult_DocMid_MengeGeliefert = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_MengeGeliefert) 'msgbox SQLResult_DocMid_MengeGeliefert.value("MengeGeliefert") Set SQLResult_DocMid_RueckstandsMenge = CWLStart.CurrentCompany.Connection.Select(SQLQuery_DocMid_RueckstandsMenge) 'msgbox SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge") IF DebugMode = "Enabled" THEN End if DocBackOrder = SQLResult_DocMid_RueckstandsMenge.value("RueckstandsMenge") 'msgbox SQLResult_DocMid_Rueckstandsmenge.value("RueckstandsMenge") IF (PostingType = 1) Then 'If doc = "Angebot" or "Angebots-storno" IF (WinLineDocType = 1) or (WinLineDocType = 11) then DocNr = DocOfferNr IF (WinLineDocType = 1) then WinLineDocType = "Angebot (debitorisch)" ElseIF (WinLineDocType = 11) then WinLineDocType = "Angebot-Storno (debitorisch)" End If 'If doc = "Auftrag" or "Auftrag-storno" ElseIf (WinLineDocType = 2) or (WinLineDocType = 12) then DocNr = DocOrderNr IF (WinLineDocType = 2) then WinLineDocType = "Auftrag (debitorisch)" ElseIF (WinLineDocType = 12) then WinLineDocType = "Auftrag-Storno (debitorisch)" End If 'If doc = "Lieferschein" or "Lieferschein-storno" or "Teillieferschein" ElseIf (WinLineDocType = 3) or (WinLineDocType = 13) or (WinLineDocType = -3) then DocNr = DocDeliveryNoteNr IF (DocBackOrder = 0) and (DocPrintState3 <> "L") then WinLineDocType = "Lieferschein (debitorisch)" ElseIF (DocBackOrder = 0) and (DocPrintState3 = "L") then WinLineDocType = "Lieferschein-Storno (debitorisch)" ElseIF (DocBackOrder <> 0) and (DocPrintState3 <> "L") then WinLineDocType = "Teillieferschein (debitorisch)" ElseIF (DocBackOrder <> 0) and (DocPrintState3 = "L") then 'Über die DB Werte ist eine Unterscheidung zwischen Lieferschein und Teillieferschein Storno nicht möglich! WinLineDocType = "Teillieferschein-Storno (debitorisch)" End If 'If doc = "Rechnung" or "Rechnungs-storno" ElseIf (WinLineDocType = 4) or (WinLineDocType = 14) then DocNr = DocInvoiceNr IF (WinLineDocType = 4) and (DocPrintState4 <> "L") then WinLineDocType = "Rechnung (debitorisch)" ElseIF (WinLineDocType = 4) and (DocPrintState4 = "L") then WinLineDocType = "Rechnung-Storno (debitorisch)" ElseIF (WinLineDocType = 14) and (DocPrintState4 = "L") then WinLineDocType = "Rechnung-Storno (debitorisch)" End If Else IF DebugMode = "Enabled" THEN MSGBOX "WinLineDocType is not configured!" & vbCrLf & _ "WinLineDocType: " & WinLineDocType, , "DEBUG - Info: Export Metadata" END IF End if ElseIf (PostingType = 2) Then 'not implement End if 'Array for the function to return DIM DocInfo(250) 'Items like T25 c000 to c188 DocInfo(59) = DocCreated DocInfo(60) = DocLastChange DocInfo(63) = DocHeadText1 DocInfo(64) = DocHeadText2 DocInfo(65) = DocHeadText3 DocInfo(66) = DocHeadText4 DocInfo(67) = DocHeadText5 DocInfo(68) = DocHeadText6 DocInfo(69) = DocHeadText7 DocInfo(70) = DocHeadText8 DocInfo(71) = DocHeadText9 DocInfo(72) = DocHeadText10 DocInfo(139) = DocType DocInfo(165) = DocComment 'Items beyond T25 DocInfo(200) = WinLineDocType DocInfo(201) = DocNr IF DebugMode = "Enabled" THEN CRLF = chr(13)&chr(10) msg = "Parameter:" & CRLF For i = 0 To Ubound(DocInfo) If (DocInfo(i) <> "") then msg = msg & i & ".: " & DocInfo(i) & CRLF end if Next msgbox msg ,, "Macro Name: " & CWLMacro.MName End if GetWinLineDocInfoByAccountAndRunningNr = DocInfo Else If DebugMode = "Enabled" Then MSGBOX "To many Rows found, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNr DocHead from Database table "& SQLTable_DocHead End If GetWinLineDocInfoByAccountAndRunningNr = "" End If End If Else If DebugMode = "Enabled" Then MSGBOX "Missing Parameter values, SQL: "& SQLQuery_DocHead,,"DEBUG - Info: Function GetWinLineDocInfoByAccountAndRunningNrDocHead from Database table " & SQLTable_DocHead End If GetWinLineDocInfoByAccountAndRunningNr = "" End If End Function