'#Language "WWB-COM"
'Machine Link
'Version 13-8-2018
'swaped Left And Right angle cuts
'list of last changes made
'add 90deg to cut angles
'28/02/2018 SMK Added in Yilmaz Saw
'02/03/2018 SMK Added in extra Yilmaz Saw fields
'13/03/2018 SMK Updated ExportYilmaz CUT_1A and CUT_2A -90degs
'14/05/2018 SM updated the cut deducion to work when catting at 135deg
'18/05/2018 SM Added ABS to the cut angles
'30/05/2018 SM removed Abs And added an ElseIf so there are formulars For ungles less than 0 And greater than 0
'30/05/2018 SM added *-1 to the FOM cut deducions to calculatethe correct IL and OL lengths
'27/06/2018 SMK added sCutAngle to allow for choice of 45 or 135 angles
'02/07/2018 SMK added b line for Emmegi
'10/07/2018 SM changed the cut angles for 45deg cuts
'11/07/2018 SMK moved B line below S line
'20/07/2018 SMK updated Yilmaz
'26/07/2018 SMK updated as over sized bars were not being taken into account
'27/07/2018 SMK updated to work in 3.5
'13/8/18 SM adjusted FOM output IL and OL
'30/8/18 SM Fixed the bar number for emmegi outtput to 1
'*** 07/03/2019 DRN - Edits for useability
'*** 05/09/2019 DRN - Edit ExportEmmegi replace Batch with QuoteNum
'*** 10/09/2019 DRN - change to FOM left and right deduction calculation.
'*** 13/09/2019 DRN - Add EXTN_CODE + ".bmp" to Yilmaz export for IMAGE column
'*** 16/09/2019 DRN - Update GetEmmegiBar Quantity to "1" as each bar is passing through
'*** 20/09/2019 DRN - Add IMAGE\ directory name to Yilmaz export for IMAGE column
'*** 27/09/2019 DRN - Modified ExportYilmaz to use BOM_BAR_ID and Order By Bar_code and UDT.PIECE_LENGTH
'*** 30/09/2019 DRN - Modified ExportYilmaz Explanation1 & Explanation2 and Order By EXTN_CODE
'*** 30/09/2019 DRN - Modified ExportTiger Order By EXTN_CODE
'*** 02/10/2019 DRN - Modified ExportYilmaz Export to use FINCOL Description
'*** 20/12/2019 DRN - Fix GetEmmegiPieces
'*** 07/01/2020 DRN - Add SeriesStr to match Emmegi USTD requirements
'*** 21/01/2020 DRN - Modified ExportYilmaz to output 1 line per cut
'*** 06/02/2020 DRN - Changed 135 Concert to 135 Convert
'*** 16/06/2020 DRN - Modified to strip any apostrophes from the extrusion description
'*** 31/08/2020 DRN - Modified to strip escape characters from FOM XML output
'*** 30/09/2020 DRN - Material Filter (only hardcoded at the moment to <> 'TIMBER')
'*** 19/10/2020 DRN - Add missing comma
'*** 19/10/2020 DRN - Add missing line
'*** 11/03/2021 DRN - Add supplier brand
'*** 27/04/2021 DRN - Update Elumatec export fields
'*** 16/08/2021 DRN - Update Elumatec export field QTE_POS
'*** 17/09/2021 DRN - Modified to strip degree character ° from FOM XML output
'*** 23/04/2022 DRN - Added export for Ozcelik machine
'*** 25/10/2022 DRN - Added export for Ozgenc machine
'*** 08/11/2022 DRN - Replaced Str functions with CStr to stop numbers having leading spaces
'*** 15/03/2023 TP - Added NCX Output
'*** 22/03/2023 TP - Changed NCX angle to use 90 when the cut is 0
'*** 22/03/2023 TP - Angle*H to use Top cut, Angle*V to use Front cut for NCX
'*** 28/07/2023 DRN - Modified ExportOzcelik
'*** 14/08/2023 DRN - Added isnull check for extrusion classification
'*** 15/08/2023 DRN - Updated FOM extract fields DOCL, BCOD, DESC, LBL
'*** 26/11/2024 DRN - Added Pertici Output
'*** 05/12/2024 DRN - Modified Pertici Output
'*** 10/12/2024 DRN - Modified Pertici Output to match fabricator optimized cutplan report
'*** 28/01/2025 DRN - Modified Elumatec Output to match fabricator optimized cutplan report
'*** 17/02/2025 DRN - Modified Yilmaz Output seperator to semicolon https://support.softtech.com/a/tickets/128663
'*** 20/05/2025 DRN - Modified Pertici Output added Item Number to position 21
'*** 09/10/2025 DRN - Modified the extraction of the CUTS field data to ensure data is not being dropped.
Option Explicit
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As _
Long) As Long
Dim sBuffer As String
Dim lAns As Long
Dim QuoteReference As String
Dim QuoteRef As String
Dim QuotePref As String
Dim QuoteNum As String
Dim QuoteSuf As String
Dim QuoteTitle As String
Dim QuoteArray As Variant
Dim QryArray As Variant
Dim QryArrayStatus As Variant
Dim QuoteId As String
Dim QryStr As String
Dim QryStatus As Variant
Dim I, J, K, L As Integer
Dim BAR_ID As String
Dim ElumatecSawfile As Object
Dim EmmegiSawfile As Object
Dim PerticiSawfile As Object
Dim Tiger As Object
Dim Yilmaz As Object
Dim bYilmazHDL As Boolean
Dim Ozcelik As Object
Dim Ozgenc As Object
Dim oXMLStruct As Object
Dim MecalSawfile As Object
Dim XmlDetail As Variant
Dim QryPlan As Variant
Dim Pieces As Variant
Dim JobNum As String
Dim QteNum As String
Dim QteItemNum As String
Dim QteItemDescr As String
Dim QteDetail As Variant
Dim SelectedStatusQuoteItems As String
Dim bNoStatus As Boolean
Dim sCutAngle As String
Dim sCutPlan As String
Dim bCutPlan0, bCutPlan2, bCutPlan5, bCutPlan9 As Boolean
Dim iStatusID As Integer
Dim sCNCFilePath As String
Dim sINIFileName As String
Dim sINIBrand As String
Sub Main
Debug.Clear
ComputerName
CreateCheckINI
QuoteReference = PickRes(rcquote)
If QuoteReference = "" Then
Exit All
Else
QuoteRef = Mid(QuoteReference,InStrRev(QuoteReference,":")+1,99)
QuotePref = Mid(QuoteRef, 1, InStr(QuoteRef, "<") -1)
QuoteNum = Mid(QuoteRef, InStr(QuoteRef, "<") + 1, InStr(QuoteRef, ">") - InStr(QuoteRef, "<") -1)
QuoteSuf = Mid(QuoteRef, InStr(QuoteRef, ">") + 1, 3)
QuoteSuf = Replace(QuoteSuf, "]", "")
'*** 07/03/2019 DRN - Get latest quote version
'QuoteArray = GetQuery("Select QUOTE_TITLE, QUOTE_ID From QUOTE Q Where Q.QUOTE_NUM = '" + QuoteNum + "' And Q.QUOTE_NUM_PREF = '" + QuotePref + "' And Q.QUOTE_NUM_SUFF = '" + QuoteSuf + "'")
QuoteArray = GetQuery("Select QUOTE_TITLE, QUOTE_ID From QUOTE Q Where Q.QUOTE_NUM = '" + QuoteNum + "' And Q.QUOTE_NUM_PREF = '" + QuotePref + "' And Q.QUOTE_NUM_SUFF = '" + QuoteSuf + "' AND Q.QUOTE_VERS = (SELECT MAX(QQ.QUOTE_VERS)FROM QUOTE QQ WHERE Q.QUOTE_ID = QQ.QUOTE_ID)")
If Not IsNull(QuoteArray) Then
If Not IsNull(QuoteArray(0,0)) Then
QuoteTitle = QuoteArray(0,0)
Else
QuoteTitle = ""
End If
QuoteID = QuoteArray(0,1)
End If
End If
QryStr = " Select Status_id, Descr from Status where area_id = 3 And Rec_Status = 'A' "
QryStatus = GetQuery(QryStr)
Dim aStatus$()
For i = 0 To UBound(QryStatus)
ReDim Preserve aStatus$(i)
aStatus$(i) = QryStatus(i,1)
Next i
Begin Dialog UserDialog 690,427,"Machining Export",.DialogFunc ' %GRID:10,7,1,1
CancelButton 570,399,90,21
OKButton 460,399,90,21
GroupBox 0,0,350,133,"Quote Details",.GroupBox1
'*** 07/03/2019 DRN - Field sizes lengthened as data was not being displayed
Text 30,21,300,14,"Prefix:- " + QuotePref,.TxtPref
Text 30,42,300,14,"Number:- " + QuoteNum,.TxtNum
Text 30,63,300,14,"Suffix:- " + QuoteSuf,.TxtSuf
Text 30,84,310,42,"Quote Title:- " + QuoteTitle,.TxtTitle
GroupBox 0,133,350,91,"Optimisation",.GroupBox5
DropListBox 150,168,180,140,aStatus(),.aStatus
OptionGroup .OptimisationOption
OptionButton 30,154,120,14,"Entire Quote",.OptionButton1
OptionButton 30,175,100,14,"Item Status",.OptionButton2
OptionButton 30,196,170,14,"Last Cut Plan/Off Cuts",.OptionButton3
GroupBox 350,0,340,336,"Machine Selection",.GroupBox2
CheckBox 380,35,150,14,"CheckBox0",.CheckBox0
CheckBox 380,60,150,14,"CheckBox1",.CheckBox1
CheckBox 380,85,150,14,"CheckBox2",.CheckBox2
CheckBox 380,110,150,14,"CheckBox3",.CheckBox3
CheckBox 380,135,150,14,"CheckBox4",.CheckBox4
CheckBox 380,160,150,14,"CheckBox5",.CheckBox5
CheckBox 380,185,150,14,"CheckBox6",.CheckBox6
CheckBox 380,210,150,14,"CheckBox7",.CheckBox7
CheckBox 380,235,150,14,"CheckBox8",.CheckBox8
CheckBox 380,260,150,14,"CheckBox9",.CheckBox9
CheckBox 380,285,150,14,"CheckBox10",.CheckBox10
GroupBox 0,224,350,63,"Angle",.GroupBox4
OptionGroup .AngleOption
OptionButton 30,245,190,14,"45 degs (Standard)",.Option45
'*** 06/02/2020 DRN - Changed 135 Concert to 135 Convert
'OptionButton 30,301,160,14,"135 degs (Concert)",.Option135
OptionButton 30,266,160,14,"135 degs (Convert)",.Option135
GroupBox 0,336,690,49,"Save To:",.GroupBox3
TextBox 30,357,480,14,.TxtFolder
PushButton 570,350,90,21,"Pick",.PickPathButton
GroupBox 0,287,350,49,"Brand",.GroupBox6
Text 30,308,140,14,"System Supplier Code",.Text1
TextBox 180,308,130,14,.TxtBrand
End Dialog
Dim varUserDialog As UserDialog
'*** 07/03/2019 DRN - Exit dialog gracefully
'Dialog varUserDialog
If Dialog(varUserDialog) = 0 Then Exit All
End Sub
Rem See DialogFunc help topic for more information.
Private Function DialogFunc(DlgItem$, Action%, SuppValue?) As Boolean
Select Case Action%
Case 1 ' Dialog box initialization
'Get a list of the machines available from lookup matrix
QryStr = "Select LIB_CODE From MATRIX M, LIBRARY L Where MATRIX_CODE = 'MACHINE LINKS'And L.LIB_ID = M.MATRIX_LIB_ID "
QryArray = GetQuery(QryStr)
Dim sLibrary As String
If IsNull(QryArray) Then
MsgBox "The lookup matrix 'MACHINE LINKS' needs to be created for this Utility to run."
Exit All
End If
If UBound(QryArray) > 0 Then 'MACHINE LINKS lookup matrix in multiple libraries so use the 'USER' library
For i = 0 To UBound(QryArray)
If QryArray(i,0) = "USER" Then
sLibrary = QryArray(i,0)
End If
Next i
If sLibrary = "" Then
MsgBox "Muliple libraries contain the lookup matrix 'MACHINE LINKS'. Please ensure there is only one matrix for the database."
Exit All
End If
Else
sLibrary = QryArray(0,0)
End If
QryStr = "Select MDX.BREAK_STR From MATRIX M"
QryStr = QryStr + " Join MATRIX_CELL_GEN MCG On"
QryStr = QryStr + " MCG.MATRIX_ID = M.MATRIX_ID And"
QryStr = QryStr + " MCG.MATRIX_LIB_ID = M.MATRIX_LIB_ID"
QryStr = QryStr + " Join MATRIX_DIM_X MDX On"
QryStr = QryStr + " MDX.MATRIX_ID = MCG.MATRIX_ID And"
QryStr = QryStr + " MDX.MATRIX_LIB_ID = MCG.MATRIX_LIB_ID And"
QryStr = QryStr + " MDX.MATRIX_DIM_X_INDEX = MCG.MATRIX_DIM_X_INDEX"
QryStr = QryStr + " Join LIBRARY L On"
QryStr = QryStr + " L.LIB_ID = M.MATRIX_LIB_ID"
QryStr = QryStr + " Where M.MATRIX_CODE = 'MACHINE LINKS' And"
QryStr = QryStr + " L.LIB_CODE = '" + sLibrary + "'"
'QryStr = QryStr + " MCG.GEN_VALUE = 'Y' Or MCG.GEN_VALUE = 'y'"
'QryStr = QryStr + " MCG.GEN_VALUE = 'Y'"
'Clipboard QryStr
QryArray = GetQuery(QryStr)
'For I = 0 To UBound(QryArray)
' DlgVisible("CheckBox" + CStr(I), False)
'Next I
For i = 0 To 10
DlgVisible("CheckBox" + CStr(i), False)
Next i
QryStr = "Select MDX.BREAK_STR From MATRIX M"
QryStr = QryStr + " Join MATRIX_CELL_GEN MCG On"
QryStr = QryStr + " MCG.MATRIX_ID = M.MATRIX_ID And"
QryStr = QryStr + " MCG.MATRIX_LIB_ID = M.MATRIX_LIB_ID"
QryStr = QryStr + " Join MATRIX_DIM_X MDX On"
QryStr = QryStr + " MDX.MATRIX_ID = MCG.MATRIX_ID And"
QryStr = QryStr + " MDX.MATRIX_LIB_ID = MCG.MATRIX_LIB_ID And"
QryStr = QryStr + " MDX.MATRIX_DIM_X_INDEX = MCG.MATRIX_DIM_X_INDEX"
QryStr = QryStr + " Join LIBRARY L On"
QryStr = QryStr + " L.LIB_ID = M.MATRIX_LIB_ID"
QryStr = QryStr + " Where M.MATRIX_CODE = 'MACHINE LINKS' And"
QryStr = QryStr + " L.LIB_CODE = '" + sLibrary + "' And"
'QryStr = QryStr + " MCG.GEN_VALUE = 'Y' Or MCG.GEN_VALUE = 'y'"
QryStr = QryStr + " MCG.GEN_VALUE = 'Y'"
'Clipboard QryStr
QryArray = GetQuery(QryStr)
If Not IsNull(QryArray) Then
For i = 0 To UBound(QryArray)
DlgVisible("CheckBox" + CStr(i), True)
DlgText("CheckBox" + CStr(i), QryArray(i,0))
Next i
End If
DlgVisible("aStatus"), False
DlgText("TxtFolder", sCNCFilePath)
DlgEnable("TxtFolder", False)
DlgText("TxtBrand", sINIBrand)
Case 2 ' Value changing or button pressed
Select Case DlgItem$
Case "OptimisationOption"
If DlgValue("OptimisationOption") = 1 Then
DlgVisible("aStatus"), True
Else
DlgVisible("aStatus"), False
End If
Case "PickPathButton"
sCNCFilePath = BrowseForFolder("C:\") '+ "\V6_Sawlink"
ChangeINI
DialogFunc = True
DlgText("TxtFolder", sCNCFilePath)
Case "OK"
CheckFolder
'*** 11/03/2021 DRN - Add supplier brand
sINIBrand = DlgText("TxtBrand")
ChangeINI
bNoStatus = False
If DlgValue("AngleOption") = 0 Then
sCutAngle = "45"
Else
sCutAngle = "135"
End If
'If DlgValue("CheckBoxItemStatus") = 1 Then
' GetSelectedStatusQuoteItems
'End If
If bNoStatus = False Then
Select Case DlgValue("OptimisationOption")
Case 0 'Optimise entire Quote
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'sCutPlan = "2"
sCutPlan = CStr(cptCustom)
ClearBars(sCutPlan)
ShowModalMsg("Creating Cutplan.. ")
CreateCutplan
EndModalMsg
Case 1 'Optimise by Quote Item Status
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'sCutPlan = "2"
sCutPlan = CStr(cptCustom)
ClearBars(sCutPlan)
GetSelectedStatusQuoteItems
'*** 07/03/2019 DRN - Check for bNoStatus
If bNoStatus= False Then
ShowModalMsg("Creating Cutplan.. ")
CreateCutplan
EndModalMsg
End If
Case 2 'Use last optimisation cut plan
If BOMCutPlanCheck(QuoteId) Then
If bCutPlan9 = True Then
sCutPlan = "9"
ElseIf bCutPlan5 Then
sCutPlan = "5"
ElseIf bCutPlan0 Then
sCutPlan = "0"
ElseIf bCutPlan2 Then
sCutPlan = "2"
Else
MsgBox("There is no current optimised cutplan.", vbInformation,"CutPlan")
End If
End If
End Select
'*** 07/03/2019 DRN - Check for bNoStatus and keep dialog open if True
If bNoStatus = False Then
SetTempExtns
For L = 0 To UBound(QryArray)
If DlgValue("CheckBox" + CStr(L)) = 1 Then
If UCase(QryArray(L,0)) = "EMMEGI" Then
ExportEmmegi
ElseIf UCase(QryArray(L,0)) = "PERTICI" Then
ExportPertici
ElseIf UCase(QryArray(L,0)) = "FOM" Then
ExportFOM
ElseIf UCase(QryArray(L,0)) = "ELUMATEC" Then
ExportElumatec
ElseIf UCase(QryArray(L,0)) = "ELUMATIC" Then
ExportElumatec
ElseIf UCase(QryArray(L,0)) = "MECAL" Then
ExportMecal
ElseIf UCase(QryArray(L,0)) = "TEKNA" Then
ExportTekna
ElseIf UCase(QryArray(L,0)) = "TIGER" Then
ExportTiger
ElseIf UCase(QryArray(L,0)) = "YILMAZ" Then
ExportYilmaz
ElseIf UCase(QryArray(L,0)) = "YILMAZHDL" Then
bYilmazHDL = True
ExportYilmaz
ElseIf UCase(QryArray(L,0)) = "OZCELIK" Then
ExportOzcelik
ElseIf UCase(QryArray(L,0)) = "OZGENC" Then
ExportOzgenc
ElseIf UCase(QryArray(L,0)) = "NCX" Then
ExportNCX
End If
End If
Next L
DialogFunc = False
Else
DialogFunc = True 'Prevent button press from closing the dialog box
End If
Else
DialogFunc = True 'Prevent button press from closing the dialog box
End If
Case "Cancel"
Exit All
End Select
Case 3 ' TextBox or ComboBox text changed
Case 4 ' Focus changed
Case 5 ' Idle
Rem Wait .1 : DialogFunc = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Function
Function BOMCutPlanCheck(QuoteID) As Boolean
Dim i As Integer
Dim qry As String
Dim QryResult As Variant
qry = "Select " + vbCr + vbLf
qry = qry + " BC.CUTPLAN_TYPE " + vbCr + vbLf
qry = qry + "FROM " + vbCr + vbLf
qry = qry + " QUOTE Q, " + vbCr + vbLf
qry = qry + " QUOTE_ITEM I, " + vbCr + vbLf
qry = qry + " BOM_PIECE BP, " + vbCr + vbLf
qry = qry + " EXTN E, " + vbCr + vbLf
qry = qry + " FINCOL F, " + vbCr + vbLf
qry = qry + " BOM_CUTPLAN_PIECE BCP, " + vbCr + vbLf
qry = qry + " BOM_CUTPLAN BC, " + vbCr + vbLf
qry = qry + " BOM_BAR BB " + vbCr + vbLf
qry = qry + "WHERE " + vbCr + vbLf
qry = qry + " Q.QUOTE_ID = I.QUOTE_ID And " + vbCr + vbLf
qry = qry + " Q.QUOTE_VERS = I.QUOTE_VERS_STOP And " + vbCr + vbLf
qry = qry + " Q.QUOTE_ID = " + CStr(QuoteID) + " And " + vbCr + vbLf
qry = qry + " Q.QUOTE_VERS = (Select MAX(QQ.QUOTE_VERS) FROM Quote QQ WHERE QQ.QUOTE_ID = Q.QUOTE_ID) And " + vbCr + vbLf
qry = qry + " E.EXTN_LIB_ID = BC.EXTN_LIB_ID And " + vbCr + vbLf
qry = qry + " E.EXTN_ID = BC.EXTN_ID And " + vbCr + vbLf
qry = qry + " F.FINCOL_LIB_ID = BC.FINCOL_LIB_ID And " + vbCr + vbLf
qry = qry + " F.FINCOL_ID = BC.FINCOL_ID And " + vbCr + vbLf
qry = qry + " BCP.BOM_CUTPLAN_ID= BB.BOM_CUTPLAN_ID And " + vbCr + vbLf
qry = qry + " BCP.BOM_PIECE_ID = BP.BOM_PIECE_ID And " + vbCr + vbLf
qry = qry + " BP.QUOTE_ITEM_ID = I.QUOTE_ITEM_ID And " + vbCr + vbLf
qry = qry + " BCP.BOM_CUTPLAN_ID= BC.BOM_CUTPLAN_ID And " + vbCr + vbLf
qry = qry + " BP.COST_BY_BOM = 'T' " + vbCr + vbLf
qry = qry + "GROUP BY " + vbCr + vbLf
qry = qry + " BC.CUTPLAN_TYPE " + vbCr + vbLf
'Clipboard qry
QryResult = GetQuery(qry)
If IsNull(QryResult) Then
BOMCutPlanCheck = False
Else
BOMCutPlanCheck = True
For i = 0 To UBound(QryResult)
Select Case QryResult(i,0)
Case 0
bCutPlan0 = True
Case 2
bCutPlan2 = True
Case 5
bCutPlan5 = True
Case 9
bCutPlan9 = True
End Select
Next i
End If
End Function
Sub CreateCutplan
Dim Optim1 As Object
Set Optim1 = New Optimizer
With Optim1
.ClearDatabase
.CutPlanType = sCutPlan
.OptMethod = omStandard
'.MultiLength = True
'.AcceptancePercent = 5
'.ExtraOpt = True
get_bom_pieces
For i = 0 To UBound(Pieces)
Debug.Print Pieces(i,14)
.AddPieceFromID(Pieces(i,10),Pieces(i,11),Pieces(i,12),Pieces(i,13),Pieces(i,14),Pieces(i,15),Pieces(i,16))
Next i
.Run
.Save
.Clear
End With
End Sub
Function GetSelectedStatusQuoteItems
iStatusID = QryStatus(DlgValue("aStatus"),0)
QryStr = " Select Qte_Pos from Quote_Item where Quote_ID = " + QuoteID + " And Item_Status_ID = " + Str(iStatusID)
QryStr = QryStr + " And Quote_Vers_Stop = (Select Max(Quote_Vers_Stop) From Quote_Item Where Quote_ID = " + QuoteID + " )"
QryArrayStatus = GetQuery(QryStr)
If IsNull(QryArrayStatus) Then
'*** 07/03/2019 DRN -
'MsgBox "No Quote Items have the Status " + QryStatus(DlgValue("aStatus"),1) + ". Please select another Status.", vbInformation, "Quote Item Status"
MsgBox "There are No Quote Items with Status: " + QryStatus(DlgValue("aStatus"),1) + vbCr + "Please select another Item Status.", vbInformation, "Quote Item Status"
bNoStatus = True
Else
SelectedStatusQuoteItems = ""
For i = 0 To UBound(QryArrayStatus)
SelectedStatusQuoteItems = SelectedStatusQuoteItems + QryArrayStatus(i,0)
If i <> UBound(QryArrayStatus) Then
SelectedStatusQuoteItems = SelectedStatusQuoteItems + ","
End If
Next i
SelectedStatusQuoteItems = "(" + SelectedStatusQuoteItems + ")"
End If
'SelectedStatusQuoteItems -> "(1,2,3,4,5,6,7)"
End Function
Public Function ComputerName() As String
sBuffer = Space$(255)
lAns = GetComputerName(sBuffer, 255)
If lAns <> 0 Then
'read from beginning of string to null-terminator
ComputerName = Left$(sBuffer, InStr(sBuffer, Chr(0)) - 1)
Else
Err.Raise Err.LastDLLError, , _
"A system call returned an error code of " _
& Err.LastDLLError
End If
End Function
Function SetTempExtns
Dim TableExists As Variant
Dim BarOffcutColumnExists As Variant
Dim QryStr As String
Dim oQuery As Object
Dim BomQuery As Object
Dim BarCount As String
Dim BarCuts As String
Dim ItemCut As String
Dim Item_ID As String
Dim ItemQty As String
Dim ListCount As Long
Dim ItemCount As Long
Dim BarQty As Integer
Dim OLD_CODE As String
Dim OLD_LENGTH As String
Set oQuery = New Query
Set BomQuery = New Query
TableExists = GetQuery("Select * from dbo.sysobjects where Name = 'UDT_QTE_MAT_QTY'")
BarOffcutColumnExists = GetQuery("Select COL_LENGTH('dbo.UDT_QTE_MAT_QTY', 'BAR_OFFCUT') ")
If Not(IsNull(TableExists)) And IsNull(BarOffcutColumnExists(0,0)) Then
QryStr = "DROP TABLE dbo.UDT_QTE_MAT_QTY"
DoQuery(QryStr)
End If
If IsNull(TableExists) Or IsNull(BarOffcutColumnExists(0,0)) Then
QryStr = "CREATE TABLE dbo.UDT_QTE_MAT_QTY ("
QryStr = QryStr + " UNIQUE_ID int IDENTITY (1, 1) Not Null,"
QryStr = QryStr + " QUOTE_ID int Null ,"
QryStr = QryStr + " QUOTE_NUM int Null ,"
QryStr = QryStr + " QUOTE_VERS int Null ,"
QryStr = QryStr + " QTE_POS int Null ,"
QryStr = QryStr + " QUOTE_ITEM_ID int Null ,"
QryStr = QryStr + " BOM_BAR_ID int Null ,"
QryStr = QryStr + " BOM_BAR_CUT_ID int Null ,"
QryStr = QryStr + " BOM_PIECE_ID int Null ,"
QryStr = QryStr + " QUANTITY int Null ,"
QryStr = QryStr + " EXTN_ID int Null ,"
QryStr = QryStr + " EXTN_LIB_ID Smallint Null ,"
QryStr = QryStr + " EXTN_CODE varchar (50) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " EXTN_DESCR varchar (80) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " EXTN_LINER varchar (50) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " EXTN_HEIGHT Numeric(28,15) Null ,"
QryStr = QryStr + " EXTN_WIDTH Numeric(28,15) Null ,"
QryStr = QryStr + " EXTN_ENDTRIM Numeric(28,15) Null ,"
QryStr = QryStr + " CLASSIF_CODE varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " FINCOL_LIB_ID Smallint Null ,"
QryStr = QryStr + " FINCOL_ID Smallint Null ,"
QryStr = QryStr + " FINCOL_CODE varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " BAR_LENGTH Numeric(28,15) Null ,"
QryStr = QryStr + " BOM_CUTPLAN_ID Int Null ,"
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID Int Null ,"
QryStr = QryStr + " BAR_QTY Int Null ,"
QryStr = QryStr + " NEW_BAR_QTY Int Null ,"
QryStr = QryStr + " TOTAL_PIECE_LENGTH Numeric(28,15) Null ,"
QryStr = QryStr + " TOTAL_BAR_LENGTH Numeric(28,15) Null, "
QryStr = QryStr + " PIECE_LENGTH Numeric(28,15) Null ,"
QryStr = QryStr + " PIECE_COUNT int Null ,"
QryStr = QryStr + " POSITION varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " COMPUTER_NAME varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " CUT_1A varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " CUT_1B varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " CUT_2A varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " CUT_2B varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null ,"
QryStr = QryStr + " EMARK varchar (20) COLLATE SQL_Latin1_General_CP1_CI_AS Null,"
QryStr = QryStr + " BAR_OFFCUT Numeric(28,15) Null ,"
QryStr = QryStr + " CONSTRAINT PK_UDT_QTE_MAT_QTY PRIMARY KEY CLUSTERED"
QryStr = QryStr + " (UNIQUE_ID) With FILLFACTOR = 90)"
DoQuery(QryStr)
End If
DoQuery("Delete From UDT_QTE_MAT_QTY ")'Where COMPUTER_NAME = '" + UserId + "'")
QryStr = "Select" + vbCrLf
QryStr = QryStr + " BOM_BAR_ID,CUTS," + vbCrLf
QryStr = QryStr + " Round(BAR_LENGTH *25.4,1) As BAR_LENGTH," + vbCrLf
QryStr = QryStr + " Round(BAR_OFFCUT *25.4,1) As BAR_OFFCUT," + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID" + vbCrLf
QryStr = QryStr + " From BOM_BAR Where" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID In (" + vbCrLf
QryStr = QryStr + " Select Distinct BCP.BOM_CUTPLAN_ID" + vbCrLf
QryStr = QryStr + " From Quote Q" + vbCrLf
QryStr = QryStr + " Join QUOTE_ITEM QI On" + vbCrLf
QryStr = QryStr + " Q.QUOTE_ID = QI.QUOTE_ID And" + vbCrLf
QryStr = QryStr + " Q.QUOTE_VERS = QI.QUOTE_VERS_STOP" + vbCrLf
QryStr = QryStr + " Join BOM_PIECE BP On" + vbCrLf
QryStr = QryStr + " BP.QUOTE_ITEM_ID = QI.QUOTE_ITEM_ID" + vbCrLf
QryStr = QryStr + " Join BOM_CUTPLAN_PIECE BCP On" + vbCrLf
QryStr = QryStr + " BP.BOM_PIECE_ID = BCP.BOM_PIECE_ID" + vbCrLf
QryStr = QryStr + " Join" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN BC On" + vbCrLf
QryStr = QryStr + " BC.BOM_CUTPLAN_ID = BCP.BOM_CUTPLAN_ID" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " Q.QUOTE_ID = '" + QuoteID + "' And" + vbCrLf
QryStr = QryStr + " Q.QUOTE_VERS = (Select MAX(QQ.QUOTE_VERS) From Quote QQ Where Q.QUOTE_ID = QQ.QUOTE_ID)" + vbCrLf
QryStr = QryStr + " And BC.CUTPLAN_TYPE = " + sCutPlan + ")"
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
ListCount = oQuery.RecordCount
While Not oQuery.Eof
ShowModalMsg("Adding Bars " + CStr(ListCount))
ListCount = ListCount -1
BarCuts = oQuery.Fields("CUTS")
Debug.Print BarCuts
While InStr(BarCuts,";") > 0
ItemCut = Left(BarCuts,InStr(BarCuts,";")-1)
If InStr(ItemCut,"*") Then
Item_ID = Left(ItemCut,InStr(ItemCut,"*")-1)
ItemQty = Mid(ItemCut,InStr(ItemCut,"*")+1,4)
Else
Item_ID = ItemCut
ItemQty = "1"
End If
'*** 09/10/2025 DRN - Modified the extraction of the CUTS field data to ensure data is not being dropped.
'BarCuts = Mid(BarCuts,InStr(BarCuts,";")+1,99)
BarCuts = Mid(BarCuts,InStr(BarCuts,";")+1,Len(BarCuts))
Debug.Print BarCuts
For ItemCount = 1 To Val(ItemQty)
QryStr = "Insert"
QryStr = QryStr + " Into"
QryStr = QryStr + " UDT_QTE_MAT_QTY"
QryStr = QryStr + " ("
QryStr = QryStr + " BAR_LENGTH,"
QryStr = QryStr + " BAR_QTY,"
QryStr = QryStr + " BOM_CUTPLAN_ID,"
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID,"
QryStr = QryStr + " BOM_BAR_ID,"
QryStr = QryStr + " COMPUTER_NAME,"
QryStr = QryStr + " TOTAL_PIECE_LENGTH,"
QryStr = QryStr + " TOTAL_BAR_LENGTH,"
QryStr = QryStr + " BAR_OFFCUT)"
QryStr = QryStr + " Values"
QryStr = QryStr + " ('" + oQuery.Fields("BAR_LENGTH") + "',"
QryStr = QryStr + " '1',"
QryStr = QryStr + " '" + oQuery.Fields("BOM_CUTPLAN_ID") + "',"
QryStr = QryStr + " '" + Item_ID + "',"
QryStr = QryStr + " '" + oQuery.Fields("BOM_BAR_ID") + "',"
QryStr = QryStr + " '" + ComputerName + "',"
QryStr = QryStr + " '" + CStr(Val(oQuery.Fields("BAR_LENGTH")) - Val(oQuery.Fields("BAR_OFFCUT"))) + "',"
QryStr = QryStr + " '" + oQuery.Fields("BAR_LENGTH") + "',"
QryStr = QryStr + " '" + oQuery.Fields("BAR_OFFCUT") + "')"
DoQuery(QryStr)
Next ItemCount
Wend
oQuery.Next
Wend
Else
End If
QryStr = "Select"
QryStr = QryStr + " BOM_BAR_ID, UNIQUE_ID"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY"
QryStr = QryStr + " Where"
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'"
QryStr = QryStr + " Order By BOM_BAR_ID"
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
While Not oQuery.Eof
If oQuery.Fields("BOM_BAR_ID") <> BAR_ID Then
DoQuery("Update UDT_QTE_MAT_QTY Set NEW_BAR_QTY = '1' where UNIQUE_ID = '" + oQuery.Fields("UNIQUE_ID") + "'")
BAR_ID = oQuery.Fields("BOM_BAR_ID")
End If
oQuery.Next
Wend
End If
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
EndModalMsg
QryStr = "Select Distinct" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'" + vbCrLf
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
ListCount = oQuery.RecordCount
While Not oQuery.Eof
ShowModalMsg("Set Cutplan " + CStr(ListCount))
ListCount = ListCount -1
QryStr = "Update UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Set" + vbCrLf
QryStr = QryStr + " BOM_PIECE_ID =" + vbCrLf
QryStr = QryStr + " (Select" + vbCrLf
QryStr = QryStr + " BOM_PIECE_ID" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_PIECE" + vbCrLf
QryStr = QryStr + " where" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID = '" + oQuery.Fields("BOM_CUTPLAN_PIECE_ID") +"')"
QryStr = QryStr + " Where"
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID = '" + oQuery.Fields("BOM_CUTPLAN_PIECE_ID") +"'"
'Clipboard QryStr
DoQuery(QryStr)
oQuery.Next
Wend
End If
QryStr = "Select" + vbCrLf
QryStr = QryStr + " Distinct BOM_PIECE_ID" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'" + vbCrLf
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
ListCount = oQuery.RecordCount
While Not oQuery.Eof
ShowModalMsg("Adding Item Details " + CStr(ListCount))
ListCount = ListCount -1
QryStr = "Select Distinct" + vbCrLf
QryStr = QryStr + " Q.QUOTE_NUM," + vbCrLf
QryStr = QryStr + " QI.QUOTE_ID," + vbCrLf
QryStr = QryStr + " QI.QTE_POS," + vbCrLf
QryStr = QryStr + " QI.QUOTE_ITEM_ID," + vbCrLf
QryStr = QryStr + " Q.QUOTE_VERS," + vbCrLf
QryStr = QryStr + " 1 As Quantity," + vbCrLf
QryStr = QryStr + " E.EXTN_ID," + vbCrLf
QryStr = QryStr + " E.EXTN_LIB_ID," + vbCrLf
QryStr = QryStr + " E.EXTN_CODE," + vbCrLf
QryStr = QryStr + " E.Descr," + vbCrLf
QryStr = QryStr + " E.UDF2," + vbCrLf
'Lokesh modification for 3.7 using Extrusion Fincolours
QryStr = QryStr + " Round((EFG.END_TRIM * 25.4),0) As END_TRIM," + vbCrLf
'QryStr = QryStr + " Round(( coalesce( EFG.END_TRIM, EFC.END_TRIM) * 25.4),0) As END_TRIM," + vbCrLf
QryStr = QryStr + " isnull(C.CLASSIF_CODE,'') as CLASSIF_CODE," + vbCrLf
QryStr = QryStr + " Round(Abs(E.EXTENT_Y1 - E.EXTENT_Y2) * 25.4,1) As EXTN_HEIGHT,"
QryStr = QryStr + " Round(Abs(E.EXTENT_X1 - E.EXTENT_X2) * 25.4,1) As EXTN_WIDTH,"
QryStr = QryStr + " Case BP.POS_INSTANCE_VALUE" + vbCrLf
QryStr = QryStr + " When 0 Then 'H'" + vbCrLf
QryStr = QryStr + " When 1 Then 'T'" + vbCrLf
QryStr = QryStr + " When 2 Then 'S'" + vbCrLf
QryStr = QryStr + " When 3 Then 'L'" + vbCrLf
QryStr = QryStr + " When 4 Then 'M'" + vbCrLf
QryStr = QryStr + " When 5 Then 'R'" + vbCrLf
QryStr = QryStr + " When 6 Then 'H'" + vbCrLf
QryStr = QryStr + " When 7 Then 'T'" + vbCrLf
QryStr = QryStr + " When 8 Then 'S'" + vbCrLf
QryStr = QryStr + " When 9 Then 'L'" + vbCrLf
QryStr = QryStr + " When 10 Then 'M'" + vbCrLf
QryStr = QryStr + " When 11 Then 'R' End As POSITION," + vbCrLf
QryStr = QryStr + " BP.FINCOL_ID," + vbCrLf
QryStr = QryStr + " BP.FINCOL_LIB_ID," + vbCrLf
QryStr = QryStr + " FC.FINCOL_CODE," + vbCrLf
QryStr = QryStr + " Round(BP.PIECE_LENGTH * 25.4,1) As PIECE_LENGTH," + vbCrLf
QryStr = QryStr + " 1 As PIECE_COUNT," + vbCrLf
QryStr = QryStr + " SUBSTRING(SUBSTRING(BP.CUT_SPEC1, CHARINDEX(',',BP.CUT_SPEC1)+1, 20),1,CHARINDEX(',',SUBSTRING(BP.CUT_SPEC1, CHARINDEX(',',BP.CUT_SPEC1)+1, 20))-1) As CUT_1A," + vbCrLf
QryStr = QryStr + " SUBSTRING(SUBSTRING(BP.CUT_SPEC1, CHARINDEX(',',BP.CUT_SPEC1)+1, 20),CHARINDEX(',',SUBSTRING(BP.CUT_SPEC1, CHARINDEX(',',BP.CUT_SPEC1)+1, 20))+1,20) As CUT_1B," + vbCrLf
QryStr = QryStr + " SUBSTRING(SUBSTRING(BP.CUT_SPEC2, CHARINDEX(',',BP.CUT_SPEC2)+1, 20),1,CHARINDEX(',',SUBSTRING(BP.CUT_SPEC2, CHARINDEX(',',BP.CUT_SPEC2)+1, 20))-1) As CUT_2A," + vbCrLf
QryStr = QryStr + " SUBSTRING(SUBSTRING(BP.CUT_SPEC2, CHARINDEX(',',BP.CUT_SPEC2)+1, 20),CHARINDEX(',',SUBSTRING(BP.CUT_SPEC2, CHARINDEX(',',BP.CUT_SPEC2)+1, 20))+1,20) As CUT_2B, " + vbCrLf
QryStr = QryStr + " Case When BP.EMARK Is Null Then 'XX' ELSE BP.EMARK End As EMARK" + vbCrLf
QryStr = QryStr + " From BOM_PIECE BP" + vbCrLf
QryStr = QryStr + " Join QUOTE_ITEM QI On" + vbCrLf
QryStr = QryStr + " QI.QUOTE_ITEM_ID = BP.QUOTE_ITEM_ID" + vbCrLf
QryStr = QryStr + " Join FINCOL FC On" + vbCrLf
QryStr = QryStr + " FC.FINCOL_ID = BP.FINCOL_ID and" + vbCrLf
QryStr = QryStr + " FC.FINCOL_LIB_ID = BP.FINCOL_LIB_ID" + vbCrLf
QryStr = QryStr + " Join Quote Q On" + vbCrLf
QryStr = QryStr + " QI.QUOTE_ID = Q.QUOTE_ID And" + vbCrLf
QryStr = QryStr + " QI.QUOTE_VERS_STOP = Q.QUOTE_VERS" + vbCrLf
QryStr = QryStr + " Join EXTN E On" + vbCrLf
QryStr = QryStr + " E.EXTN_ID = BP.EXTN_ID And" + vbCrLf
QryStr = QryStr + " E.EXTN_LIB_ID = BP.EXTN_LIB_ID" + vbCrLf
QryStr = QryStr + " Left Join EXTN_FINGRP_LINK EFG On" + vbCrLf
QryStr = QryStr + " E.EXTN_ID = EFG.EXTN_ID And" + vbCrLf
QryStr = QryStr + " E.EXTN_LIB_ID = EFG.EXTN_LIB_ID And" + vbCrLf
QryStr = QryStr + " FC.FINGRP_ID = EFG.FINGRP_ID And" + vbCrLf
QryStr = QryStr + " FC.FINGRP_LIB_ID = EFG.FINGRP_LIB_ID" + vbCrLf
'Lokesh modification for 3.7 using Extrusion Fincolours
'QryStr = QryStr + " Left Join EXTN_FINCOL_LINK EFC On" + vbCrLf
'QryStr = QryStr + " E.EXTN_ID = EFC.EXTN_ID And" + vbCrLf
'QryStr = QryStr + " E.EXTN_LIB_ID = EFC.EXTN_LIB_ID And" + vbCrLf
'QryStr = QryStr + " FC.FINCOL_ID = EFC.FINCOL_ID And" + vbCrLf
'QryStr = QryStr + " FC.FINCOL_LIB_ID = EFC.FINCOL_LIB_ID" + vbCrLf
QryStr = QryStr + " Left Join CLASSIFICATION C On" + vbCrLf
QryStr = QryStr + " E.CLASSIF_ID = C.CLASSIF_ID And" + vbCrLf
QryStr = QryStr + " E.CLASSIF_LIB_ID = C.CLASSIF_LIB_ID" + vbCrLf
QryStr = QryStr + " Where BOM_PIECE_ID = '" + oQuery.Fields("BOM_PIECE_ID") + "'"
'Clipboard QryStr
BomQuery.Close
BomQuery.SQL = QryStr
BomQuery.Open
If BomQuery.RecordCount > 0 Then
While Not BomQuery.Eof
QryStr = "Update" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Set" + vbCrLf
QryStr = QryStr + " QUOTE_NUM = '" + BomQuery.Fields("QUOTE_NUM") + "'," + vbCrLf
QryStr = QryStr + " QUOTE_ID = '" + BomQuery.Fields("QUOTE_ID") + "'," + vbCrLf
QryStr = QryStr + " QUOTE_VERS = '" + BomQuery.Fields("QUOTE_VERS") + "'," + vbCrLf
QryStr = QryStr + " QUOTE_ITEM_ID = '" + BomQuery.Fields("QUOTE_ITEM_ID") + "'," + vbCrLf
QryStr = QryStr + " QTE_POS = '" + BomQuery.Fields("QTE_POS") + "'," + vbCrLf
QryStr = QryStr + " QUANTITY = '1'," + vbCrLf
QryStr = QryStr + " EXTN_ID = '" + BomQuery.Fields("EXTN_ID") + "'," + vbCrLf
QryStr = QryStr + " EXTN_LIB_ID = '" + BomQuery.Fields("EXTN_LIB_ID") + "'," + vbCrLf
QryStr = QryStr + " EXTN_CODE = '" + BomQuery.Fields("EXTN_CODE") + "'," + vbCrLf
'*** 16/06/2020 DRN - Stripping extra apostrophes from extrusion description
'QryStr = QryStr + " EXTN_DESCR = '" + BomQuery.Fields("DESCR") + "'," + vbCrLf
QryStr = QryStr + " EXTN_DESCR = '" + Replace(BomQuery.Fields("DESCR"),"'","") + "'," + vbCrLf
QryStr = QryStr + " EXTN_HEIGHT = '" + BomQuery.Fields("EXTN_HEIGHT") + "'," + vbCrLf
QryStr = QryStr + " EXTN_WIDTH = '" + BomQuery.Fields("EXTN_WIDTH") + "'," + vbCrLf
QryStr = QryStr + " EXTN_ENDTRIM = '" + BomQuery.Fields("END_TRIM") + "'," + vbCrLf
QryStr = QryStr + " CLASSIF_CODE = '" + BomQuery.Fields("CLASSIF_CODE") + "'," + vbCrLf
If IsNull BomQuery.Fields("UDF2") Then
QryStr = QryStr + " EXTN_LINER = 'EXTN'," + vbCrLf
Else
QryStr = QryStr + " EXTN_LINER = '" + BomQuery.Fields("UDF2") + "'," + vbCrLf
End If
QryStr = QryStr + " FINCOL_ID = '" + BomQuery.Fields("FINCOL_ID") + "'," + vbCrLf
QryStr = QryStr + " FINCOL_LIB_ID = '" + BomQuery.Fields("FINCOL_LIB_ID") + "'," + vbCrLf
QryStr = QryStr + " FINCOL_CODE = '" + BomQuery.Fields("FINCOL_CODE") + "'," + vbCrLf
QryStr = QryStr + " PIECE_COUNT = '1'," + vbCrLf
QryStr = QryStr + " PIECE_LENGTH = '" + BomQuery.Fields("PIECE_LENGTH") + "'," + vbCrLf
QryStr = QryStr + " POSITION = '" + BomQuery.Fields("POSITION") + "'," + vbCrLf
QryStr = QryStr + " EMARK = '" + BomQuery.Fields("EMARK") + "'," + vbCrLf
If sCutAngle = "135" Then
'here is where we work out the angles to be cut for 135 deg cuts
'Cut A
'here is where we add the sum if the angle is less than 0 so it outputs angles to 135 or to suit glass up
If BomQuery.Fields("CUT_1A") < 0 Then
QryStr = QryStr + " CUT_2A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_1A"))+180-90)) +"'," + vbCrLf
'here is where we add a sum if the angle is greater than 0 so it out puts 135 or to suit glass up
ElseIf BomQuery.Fields("CUT_1A") > 0 Then
QryStr = QryStr + " CUT_2A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_1A")) +90)) +"'," + vbCrLf
'here is where we add the sum for 90 deg angles
Else
QryStr = QryStr + " CUT_2A = '90'," + vbCrLf
End If
'cut 1B is for if it is a T angle
QryStr = QryStr + " CUT_2B = '" + BomQuery.Fields("CUT_1B") + "'," + vbCrLf
'cut 2
'here is where we add the sum if the angle is less than 0 so it outputs angles to 135 or to suit glass up
If BomQuery.Fields("CUT_2A") < 0 Then
'*** 19/10/2020 DRN - Add missing comma
'QryStr = QryStr + " CUT_1A = '" + Trim(Str(CDbl(BomQuery.Fields("CUT_2A")) +180-90)) +"'" + vbCrLf
QryStr = QryStr + " CUT_1A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_2A")) +180-90)) +"'," + vbCrLf
'here is where we add a sum if the angle is greater than 0 so it out puts 135 or to suit glass up
ElseIf BomQuery.Fields("CUT_2A") > 0 Then
'*** 19/10/2020 DRN - Add missing comma
'QryStr = QryStr + " CUT_1A = '" + Trim(Str(CDbl(BomQuery.Fields("CUT_2A"))+90)) +"'" + vbCrLf
QryStr = QryStr + " CUT_1A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_2A"))+90)) +"'," + vbCrLf
'here is where we add the sum for 90 deg angles
Else
'*** 19/10/2020 DRN - Add missing comma
'QryStr = QryStr + " CUT_1A = '90'" + vbCrLf
QryStr = QryStr + " CUT_1A = '90'," + vbCrLf
End If
'cut 1B is for if it is a T angle
'*** 19/10/2020 DRN - Add missing line
QryStr = QryStr + " CUT_1B = '" + BomQuery.Fields("CUT_2B") + "'" + vbCrLf
Else ' "45"
'here is where we work out the angles to be cut for 45 deg
'Cut A
'here is where we add the sum "if the angle is less than 0deg add a calc to convert the angle to 45deg
If BomQuery.Fields("CUT_1A") < 0 Then
QryStr = QryStr + " CUT_1A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_1A")) *-1+90)) +"'," + vbCrLf
'here is where we add the sum if the angle is greater than 0deg add a calc to convert the angle to 45deg
ElseIf BomQuery.Fields("CUT_1A") > 0 Then
QryStr = QryStr + " CUT_1A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_1A"))*-1+180-90)) +"'," + vbCrLf
'here is were we set 90deg
Else
QryStr = QryStr + " CUT_1A = '90'," + vbCrLf
End If
'cut 1B is for if it is a T angle
QryStr = QryStr + " CUT_1B = '" + BomQuery.Fields("CUT_1B") + "'," + vbCrLf
'cut 2
'here is where we add the sum "if the angle is less than 0deg add a calc to convert the angle to 45deg
If BomQuery.Fields("CUT_2A") < 0 Then
QryStr = QryStr + " CUT_2A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_2A"))*-1+90)) +"'," + vbCrLf
'here is where we add the sum if the angle is greater than 0deg add a calc to convert the angle to 45deg
ElseIf BomQuery.Fields("CUT_2A") > 0 Then
QryStr = QryStr + " CUT_2A = '" + Trim(CStr(CDbl(BomQuery.Fields("CUT_2A"))*-1+180-90)) +"'," + vbCrLf
'here is were we set 90deg
Else
QryStr = QryStr + " CUT_2A = '90'," + vbCrLf
End If
QryStr = QryStr + " CUT_2B = '" + BomQuery.Fields("CUT_2B") + "'" + vbCrLf
End If
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " BOM_PIECE_ID = '" + oQuery.Fields("BOM_PIECE_ID") + "'"
'Clipboard QryStr
DoQuery(QryStr)
BomQuery.Next
Wend
End If
oQuery.Next
Wend
End If
QryStr = "Select Distinct" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'" + vbCrLf
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
While Not oQuery.Eof
QryStr = "Select" + vbCrLf
QryStr = QryStr + " Round(SUM(BAR_LENGTH * 25.4),1) AS BAR_LENGTH," + vbCrLf
QryStr = QryStr + " Round(SUM(BAR_OFFCUT * 25.4),1) AS BAR_OFFCUT" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " BOM_BAR" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID = '" + oQuery.Fields("BOM_CUTPLAN_ID") + "'"
BomQuery.Close
BomQuery.SQL = QryStr
BomQuery.Open
If BomQuery.RecordCount > 0 Then
While Not BomQuery.Eof
QryStr = "Update" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Set"
QryStr = QryStr + " TOTAL_BAR_LENGTH = '" + BomQuery.Fields("BAR_LENGTH") + "',"
QryStr = QryStr + " TOTAL_PIECE_LENGTH = '" + CStr(Val(BomQuery.Fields("BAR_LENGTH")) - Val(BomQuery.Fields("BAR_OFFCUT"))) + "'"
QryStr = QryStr + " Where"
QryStr = QryStr + " BOM_CUTPLAN_ID = '" + oQuery.Fields("BOM_CUTPLAN_ID") + "'"
'Clipboard QryStr
DoQuery(QryStr)
BomQuery.Next
Wend
End If
oQuery.Next
Wend
End If
'SMK Changed to get piece length from bom_cutplan_piece as over sized bars weren't being taken into account
QryStr = "Select Distinct" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID" + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'" + vbCrLf
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
While Not oQuery.Eof
QryStr = "Select" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID, " + vbCrLf
QryStr = QryStr + " Round(PIECE_LENGTH * 25.4,2) AS PIECE_LENGTH " + vbCrLf
QryStr = QryStr + " From" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_PIECE" + vbCrLf
QryStr = QryStr + " Where" + vbCrLf
QryStr = QryStr + " BOM_CUTPLAN_ID = '" + oQuery.Fields("BOM_CUTPLAN_ID") + "'"
'Clipboard QryStr
BomQuery.Close
BomQuery.SQL = QryStr
BomQuery.Open
If BomQuery.RecordCount > 0 Then
While Not BomQuery.Eof
QryStr = "Update" + vbCrLf
QryStr = QryStr + " UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Set"
QryStr = QryStr + " PIECE_LENGTH = '" + BomQuery.Fields("PIECE_LENGTH") + "'"
QryStr = QryStr + " Where"
QryStr = QryStr + " BOM_CUTPLAN_PIECE_ID = '" + BomQuery.Fields("BOM_CUTPLAN_PIECE_ID") + "'"
'Clipboard QryStr
DoQuery(QryStr)
BomQuery.Next
Wend
End If
oQuery.Next
Wend
End If
'New Piece length work End
QryStr = "Select" + vbCrLf
QryStr = QryStr + " DISTINCT EXTN_CODE, BOM_BAR_ID, BAR_LENGTH" + vbCrLf
QryStr = QryStr + " from UDT_QTE_MAT_QTY" + vbCrLf
QryStr = QryStr + " Group by EXTN_CODE, BOM_BAR_ID, BAR_LENGTH" + vbCrLf
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
BarQty = 1
If oQuery.RecordCount > 0 Then
While Not oQuery.Eof
If oQuery.Fields("EXTN_CODE") = OLD_CODE And oQuery.Fields("BAR_LENGTH") = OLD_LENGTH Then
BarQty = BarQty + 1
Else
BarQty = 1
End If
OLD_CODE = oQuery.Fields("EXTN_CODE")
OLD_LENGTH = oQuery.Fields("BAR_LENGTH")
QryStr = "Update UDT_QTE_MAT_QTY Set BAR_QTY = '" + CStr(BarQty) + "' Where EXTN_CODE = '" + OLD_CODE + "' And BAR_LENGTH = '" + OLD_LENGTH + "'"
DoQuery(QryStr)
oQuery.Next
Wend
End If
EndModalMsg
End Function
Function ExportEmmegi
Set EmmegiSawfile = New TextFile
CheckSubFolderEmmegi
EmmegiSawfile.FileName = sCNCFilePath + "\Emmegi\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".txt"
EmmegiSawfile.Clear
EmmegiSawfile.Open
EmmegiSawfile.Append("C;" + QuoteNum + ";;" + CStr(Day(Date)) + " " + CStr(MonthName(Month(Date))) + " " + CStr(Year(Date)))
GetEmmegiBarDetails
End Function
Function ExportPertici
Set PerticiSawfile = New TextFile
CheckSubFolderPertici
PerticiSawfile.FileName = sCNCFilePath + "\Pertici\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".txt"
PerticiSawfile.Clear
PerticiSawfile.Open
PerticiSawfile.Append("L," + QuoteNum + ",CUT")
GetPerticiBarDetails
End Function
Function ExportFOM
Set oXMLStruct = New TextFile
CheckSubFolderFOM
oXMLStruct.FileName = sCNCFilePath + "\Fom\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".xml"
oXMLStruct.Clear
oXMLStruct.Open
oXMLStruct.Append("")
oXMLStruct.Append("")
oXMLStruct.Append("1")
oXMLStruct.Append("0")
oXMLStruct.Append("")
oXMLStruct.Append("")
GetBarDetails
oXMLStruct.Append("")
oXMLStruct.Append("")
GetPieceDetails
oXMLStruct.Append("")
oXMLStruct.Append("")
End Function
Function ExportElumatec
Dim oQuery As Object
Dim PieceStr As String
Dim OLD_BAR_ID As Long
Set oQuery = New Query
CheckSubFolderElumatec
Set ElumatecSawfile = New TextFile
ElumatecSawfile.FileName = sCNCFilePath + "\Elumatec\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".txt"
ElumatecSawfile.Clear
ElumatecSawfile.Open
QryStr = "Select"
QryStr = QryStr + " DENSE_RANK() OVER (ORDER BY UDT.BAR_OFFCUT, UDT.BOM_BAR_ID) As BAR_NO,"
QryStr = QryStr + " UDT.BAR_LENGTH,"
QryStr = QryStr + " UDT.PIECE_LENGTH,"
QryStr = QryStr + " UDT.CUT_1B,"
QryStr = QryStr + " UDT.CUT_1A,"
QryStr = QryStr + " UDT.CUT_2B,"
QryStr = QryStr + " UDT.CUT_2A,"
QryStr = QryStr + " UDT.EXTN_CODE,"
QryStr = QryStr + " UDT.EXTN_DESCR,"
QryStr = QryStr + " UDT.FINCOL_CODE,"
QryStr = QryStr + " UDT.BOM_BAR_ID,"
QryStr = QryStr + " Q.QUOTE_TITLE,"
QryStr = QryStr + " QI.DESCR AS ITEM_DESCR,"
QryStr = QryStr + " UDT.POSITION,"
QryStr = QryStr + " BP.IDENT,"
QryStr = QryStr + " UDT.QTE_POS "
QryStr = QryStr + " From UDT_QTE_MAT_QTY UDT"
'*** 27/04/2021 DRN - Update Elumatec export fields
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UDT.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UDT.QUOTE_VERS"
QryStr = QryStr + " Join Quote_Item QI On"
QryStr = QryStr + " QI.QUOTE_ID = Q.QUOTE_ID And"
QryStr = QryStr + " QI.QUOTE_ITEM_ID = UDT.QUOTE_ITEM_ID"
QryStr = QryStr + " Join BOM_PIECE BP On"
QryStr = QryStr + " BP.BOM_PIECE_ID = UDT.BOM_PIECE_ID And"
QryStr = QryStr + " BP.QUOTE_ITEM_ID = UDT.QUOTE_ITEM_ID And"
QryStr = QryStr + " BP.EXTN_LIB_ID = UDT.EXTN_LIB_ID And"
QryStr = QryStr + " BP.EXTN_ID = UDT.EXTN_ID And"
QryStr = QryStr + " BP.FINCOL_LIB_ID = UDT.FINCOL_LIB_ID And"
QryStr = QryStr + " BP.FINCOL_ID = UDT.FINCOL_ID"
QryStr = QryStr + " Where"
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'"
QryStr = QryStr + " ORDER BY"
'QryStr = QryStr + " UDT.EXTN_CODE, UDT.FINCOL_CODE,UDT.BOM_BAR_ID, UDT.PIECE_LENGTH DESC"
QryStr = QryStr + " UDT.EXTN_CODE,UDT.BAR_OFFCUT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH desc, UDT.QTE_POS"
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
ElumatecSawfile.Append(Chr(02) + "1" + StrZero(CStr(oQuery.RecordCount),4,"RIGHT") + "12345678" + Chr(03))
While Not oQuery.Eof
PieceStr = PieceStr + Chr(02)
If oQuery.Fields("BOM_BAR_ID") <> OLD_BAR_ID Then
PieceStr = PieceStr + Replace(Format(oQuery.Fields("BAR_LENGTH"),"0000.000"),".","") 'Bar Length
Else
PieceStr = PieceStr + "0000000"
End If
PieceStr = PieceStr + Replace(Format(oQuery.Fields("PIECE_LENGTH"),"0000.000"),".","") 'Length
PieceStr = PieceStr + "0001" 'Target
PieceStr = PieceStr + Replace(Format(90 - oQuery.Fields("CUT_1B"),"000.00"),".","") 'Pivoting Fixed Unit
PieceStr = PieceStr + Replace(Format(oQuery.Fields("CUT_1A"),"000.00"),".","") 'L Angle Head
PieceStr = PieceStr + Replace(Format(90 - oQuery.Fields("CUT_2B"),"000.00"),".","") 'Pivoting Fixed Unit
PieceStr = PieceStr + Replace(Format(oQuery.Fields("CUT_2A"),"000.00"),".","") 'R Angle Head
PieceStr = PieceStr + StrSpace(oQuery.Fields("EXTN_CODE"),10, "RIGHT") 'Extrusion Code
'*** 27/04/2021 DRN - Update Elumatec export fields
'PieceStr = PieceStr + StrSpace(oQuery.Fields("EXTN_DESCR"),14, "LEFT") 'Extrusion Description
PieceStr = PieceStr + StrSpace(oQuery.Fields("ITEM_DESCR"),14, "LEFT") 'Extrusion Description
'***16/08/2021 DRN - Update Elumatec export field QTE_POS
'PieceStr = PieceStr + "0000" 'Bin Number
PieceStr = PieceStr + Format(oQuery.Fields("QTE_POS"),"0000") 'Bin Number
'*** 27/04/2021 DRN - Update Elumatec export fields
'PieceStr = PieceStr + "0000000000" 'Commission
PieceStr = PieceStr + StrSpace(oQuery.Fields("QUOTE_TITLE"),10, "LEFT") 'Commission
'*** 27/04/2021 DRN - Update Elumatec export fields
'PieceStr = PieceStr + "0000000000" 'Position Number
PieceStr = PieceStr + StrSpace(ExtractIdent(oQuery.Fields("IDENT")),10, "LEFT") 'Position Number
PieceStr = PieceStr + StrSpace(oQuery.Fields("FINCOL_CODE"),10,"LEFT") 'Colour
PieceStr = PieceStr + "00000" 'BAR CODE
PieceStr = PieceStr + "000000" 'Offcuts Left Unit
PieceStr = PieceStr + "000000" 'Offcuts Right Unit
PieceStr = PieceStr + "000000" 'Offcuts Left Tilting Unit
PieceStr = PieceStr + "000000" 'Offcuts Right Tilting Unit
PieceStr = PieceStr + Chr(03)
PieceStr = PieceStr + vbCrLf
OLD_BAR_ID = oQuery.Fields("BOM_BAR_ID")
oQuery.Next
Wend
End If
ElumatecSawfile.Append(PieceStr)
End Function
Function ExtractIdent(RawIdent)
Dim sIdent As String
If IsNull(RawIdent) Then
sIdent = ""
Else
RawIdent = Replace(RawIdent, " ", "")
If InStr(RawIdent,"(") >0 Then
sIdent = Left(Mid(RawIdent,InStr(1,RawIdent,"(")+1),InStr(1,Mid(RawIdent,InStr(1,RawIdent,"(")+1),")")-1)
Else
sIdent = RawIdent
End If
End If
ExtractIdent = sIdent
End Function
Function ExportTiger
Dim oQuery As Object
Dim PieceStr As String
Set oQuery = New Query
CheckSubFolderTiger
Set Tiger = New TextFile
Tiger.FileName = sCNCFilePath + "\Tiger\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".csv"
Tiger.Clear
Tiger.Open
QryStr = "Select"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, STR(UDT.BOM_BAR_ID) as BAR_CODE, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, CUT_1A, CUT_2A, BAR_LENGTH"
QryStr = QryStr + " From UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UDT.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UDT.QUOTE_VERS"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " Customer C On"
QryStr = QryStr + " C.CUST_ID = Q.CUST_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC On"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID And"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID"
QryStr = QryStr + " Join EXTN E On"
QryStr = QryStr + " UDT.EXTN_ID = E.EXTN_ID And"
QryStr = QryStr + " UDT.EXTN_LIB_ID = E.EXTN_LIB_ID"
QryStr = QryStr + " Join MATERIAL M On"
QryStr = QryStr + " M.MATERIAL_ID = E.MATERIAL_ID And"
QryStr = QryStr + " M.MATERIAL_LIB_ID = E.MATERIAL_LIB_ID"
QryStr = QryStr + " Join SUPPLIER S On"
QryStr = QryStr + " E.SUPP_ID = S.SUPP_ID And"
QryStr = QryStr + " E.SUPP_LIB_ID = S.SUPP_LIB_ID"
QryStr = QryStr + " Group By"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, UDT.EXTN_DESCR, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH"
'*** 30/09/2019 DRN - Modified ExportTiger
'QryStr = QryStr + " Order By Bar_code, udt.piece_length desc "
QryStr = QryStr + " Order By UDT.EXTN_CODE, Bar_code, UDT.PIECE_LENGTH DESC "
oQuery.Close
oQuery.SQL = QryStr
'Clipboard QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
Tiger.Append("Job Number, Customer, Material, Supplier, Profile Code, Finish, Description, Bar Code, Quantity, Piece Length, Left Angle, Right Angle, Bar Length")
While Not oQuery.Eof
PieceStr = ""
PieceStr = PieceStr + oQuery.Fields("QUOTE_NUM")
PieceStr = PieceStr + ","
If Not IsNull(oQuery.Fields("CUST_NAME")) Then
PieceStr = PieceStr + oQuery.Fields("CUST_NAME")
End If
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("MATERIAL_CODE")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("SUPP_COMP_NAME")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("EXTN_CODE")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("FINCOL_CODE")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("EXTN_DESCR")
PieceStr = PieceStr + ","
PieceStr = PieceStr + "*" + Trim(oQuery.Fields("QUOTE_NUM")) + Trim(oQuery.Fields("BAR_CODE")) + "*"
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("PIECE_COUNT")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("PIECE_LENGTH")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("CUT_1A")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("CUT_2A")
PieceStr = PieceStr + ","
PieceStr = PieceStr + oQuery.Fields("BAR_LENGTH")
PieceStr = PieceStr + ","
Tiger.Append PieceStr
oQuery.Next
Wend
End If
End Function
Function ExportMecal
Dim oQuery As Object
Dim PieceStr As String
Dim MecalArray As Variant
Set MecalSawfile = New TextFile
Dim strLine As String
Dim BarCounter As Integer
Dim PrevBarID As String
Dim RodNum As Integer
CheckSubFolderMecal
MecalSawfile.FileName = sCNCFilePath + "\Mecal\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".lte"
MecalSawfile.Clear
MecalSawfile.Open
QryStr = "Select"
QryStr = QryStr + " UMQ.QUOTE_NUM," '0
QryStr = QryStr + " QTE_POS," '1
QryStr = QryStr + " FINCOL_CODE," '2
QryStr = QryStr + " EXTN_CODE," '3
QryStr = QryStr + " CUT_1A," '4
QryStr = QryStr + " CUT_1B," '5
QryStr = QryStr + " CUT_2A," '6
QryStr = QryStr + " CUT_2B," '7
QryStr = QryStr + " C.CUST_NAME," '8
QryStr = QryStr + " BOM_BAR_ID," '9
QryStr = QryStr + " QUANTITY," '10
QryStr = QryStr + " PIECE_LENGTH" '11
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY UMQ"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UMQ.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UMQ.QUOTE_VERS"
QryStr = QryStr + " Left Join Customer C On"
QryStr = QryStr + " Q.CUST_ID = C.CUST_ID"
QryStr = QryStr + " Where"
QryStr = QryStr + " COMPUTER_NAME = '" + ComputerName + "'"
MecalArray = GetQuery(QryStr)
BarCounter = 1
For i = 0 To UBound(MecalArray)
' C1 1-12 12 Order Quote Number/Item Position
strLine = CStr(MecalArray(i,0)) + "/" + CStr(MecalArray(i,1))
If Len(strLine) > 12 Then
strLine = Left(strLine, 12)
Else
strLine = strLine + Space$(12 - Len(strLine))
End If
' C2 13-24 12 Client Customer Name
If Not IsNull(MecalArray(i, 8)) Then
strLine = strLine + MecalArray(i, 8)
If Len(strLine) > 24 Then
strLine = Left(strLine, 24)
Else
strLine = strLine + Space$(24 - Len(strLine))
End If
Else
strLine = strLine + Space$(12)
End If
' C3 25-36 12 Typology Not required by saw. Appears on label
strLine = strLine + Space$(12)
'strLine = strLine + "C3**********"
' C4 37-43 7 Frame Height Not required by saw. Appears on label
strLine = strLine + Space$(7)
'strLine = strLine + "C4*****"
' C5 44-50 7 Frame Width Not required by saw. Appears on label
strLine = strLine + Space$(7)
'strLine = strLine + "C5*****"
' C6 51-62 12 Colour Not required by saw. Appears on label
strLine = strLine + MecalArray(i, 2)
If Len(strLine) > 62 Then
strLine = Left(strLine, 62)
Else
strLine = strLine + Space$(62 - Len(strLine))
End If
' C7 63-66 4 Line Number Incremental number. Same as row number from QryBars
strLine = strLine + CStr(BarCounter)
If Len(strLine) > 66 Then
strLine = Left(strLine, 66)
Else
strLine = strLine + Space$(66 - Len(strLine))
End If
' C8 67-74 8 Bar Initials Not required by saw. Appears on label
'strLine = strLine + Space$(8)
If MecalArray(i, 9) <> PrevBarID Then RodNum = RodNum + 1
strLine = strLine + CStr(Format(RodNum, "0#"))
If Len(strLine) > 74 Then
strLine = Left(strLine, 74)
Else
strLine = strLine + Space$(74 - Len(strLine))
End If
PrevBarID = MecalArray(i, 9)
' C9 75-82 8 Section Name Name of section file. SectionFileName 'requires modofication per suite
'strLine = strLine + fncMecalSW453SectionFileName(QryCutPlan(J, 6), QryCutPlan(J, 4))
'If Len(strLine) > 82 Then
' strLine = Left(strLine, 82)
'Else
strLine = strLine + Space$(82 - Len(strLine))
'End If
' C10 83-90 8 Profile Code Extrusion code
strLine = strLine + MecalArray(i, 3)
If Len(strLine) > 90 Then
strLine = Left(strLine, 90)
Else
strLine = strLine + Space$(90 - Len(strLine))
End If
' C11 91-95 5 Cut Angle Left ###.0 format
strLine = strLine + MecalArray(i, 4)
If Len(strLine) > 95 Then
strLine = Left(strLine, 95)
Else
strLine = strLine + Space$(95 - Len(strLine))
End If
' C12 96-100 5 Cut chamfer L 90.0 in most cases
strLine = strLine + MecalArray(i, 5)
If Len(strLine) > 100 Then
strLine = Left(strLine, 100)
Else
strLine = strLine + Space$(100 - Len(strLine))
End If
' C13 101-105 5 Cut Angle Right ###.0 format
strLine = strLine + MecalArray(i, 6)
If Len(strLine) > 105 Then
strLine = Left(strLine, 105)
Else
strLine = strLine + Space$(105 - Len(strLine))
End If
' C14 106-110 5 Cut chamfer R 90.0 in most cases
strLine = strLine + MecalArray(i, 7)
If Len(strLine) > 110 Then
strLine = Left(strLine, 110)
Else
strLine = strLine + Space$(110 - Len(strLine))
End If
' C15 111-113 3 Pieces Number Quantity off with featured cutting
strLine = strLine + MecalArray(i, 10)
If Len(strLine) > 113 Then
strLine = Left(strLine, 113)
Else
strLine = strLine + Space$(113 - Len(strLine))
End If
' C16 114-120 7 Max Length Cut length of piece #####.0
strLine = strLine + MecalArray(i, 11)
If Len(strLine) > 120 Then
strLine = Left(strLine, 120)
Else
strLine = strLine + Space$(120 - Len(strLine))
End If
' C17 121-127 7 Length Sup P Set to 0
strLine = strLine + "0 "
' C18 128 1 Support Side Indicates the internal/external side on which the profile
' has been placed on the machine. Usually left blank
strLine = strLine + " "
' C19 129 1 Bar Tilting Command to opererator to manually tilt bar during cutting.
' Usually left blank
strLine = strLine + " "
' C20 130-133 4 Typology Progress Number Usually 1
strLine = strLine + "1 "
' C21 134 1 Left side end-milling Usually blank
strLine = strLine + " "
' C22 135 1 Right side end-milling Usually blank
strLine = strLine + " "
' C23 136 1 Peak-peak cut on left side Usually blank
strLine = strLine + " "
' C24 137 1 Peak-peak cut on right side Usually blank
strLine = strLine + " "
' C25 138-149 12 Notes Not required by saw.
' Set blank or continue item numbers
'strLine = strLine + "C25*********"
If Len(CStr(MecalArray(i, 0)) + "/" + CStr(MecalArray(i, 1))) > 12 Then
strLine = strLine + Right(CStr(MecalArray(i, 0)) + "/" + MecalArray(i, 1), Len(CStr(MecalArray(i, 0)) + "/" + MecalArray(i, 1)) - 12)
If Len(strLine) > 149 Then
strLine = Left(strLine, 149)
Else
strLine = strLine + Space$(149 - Len(strLine))
End If
Else
strLine = strLine + Space$(12)
End If
MecalSawfile.Append strLine
Next i
End Function
Function ExportTekna
End Function
Function ExportYilmaz
Dim oQuery As Object
Dim PieceStr As String
Set oQuery = New Query
CheckSubFolderYilmaz
Set Yilmaz = New TextFile
Yilmaz.FileName = sCNCFilePath + "\Yilmaz\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".csv"
Yilmaz.Clear
Yilmaz.Open
QryStr = "Select"
'*** 27/09/2019 DRN - Modified ExportYilmaz to use BOM_BAR_ID and Order By Bar_code and UDT.PIECE_LENGTH
'QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, STR(UDT.BOM_PIECE_ID) as BAR_CODE, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, CUT_1A, CUT_2A"
'*** 02/10/2019 DRN - Modified ExportYilmaz Export to use FINCOL Description
'QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, STR(UDT.BOM_BAR_ID) as BAR_CODE, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.DESCR AS ITEM_DESCR, QI.CUST_REF"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR AS FINCOL_DESCR, STR(UDT.BOM_BAR_ID) as BAR_CODE, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.DESCR AS ITEM_DESCR, QI.CUST_REF"
QryStr = QryStr + " From UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UDT.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UDT.QUOTE_VERS"
QryStr = QryStr + " Join Quote_Item QI On"
QryStr = QryStr + " QI.QUOTE_ID = Q.QUOTE_ID And"
QryStr = QryStr + " QI.QUOTE_ITEM_ID = UDT.QUOTE_ITEM_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " Customer C On"
QryStr = QryStr + " C.CUST_ID = Q.CUST_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC On"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID And"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID"
QryStr = QryStr + " Join EXTN E On"
QryStr = QryStr + " UDT.EXTN_ID = E.EXTN_ID And"
QryStr = QryStr + " UDT.EXTN_LIB_ID = E.EXTN_LIB_ID"
QryStr = QryStr + " Join MATERIAL M On"
QryStr = QryStr + " M.MATERIAL_ID = E.MATERIAL_ID And"
QryStr = QryStr + " M.MATERIAL_LIB_ID = E.MATERIAL_LIB_ID"
QryStr = QryStr + " Join SUPPLIER S On"
QryStr = QryStr + " E.SUPP_ID = S.SUPP_ID And"
QryStr = QryStr + " E.SUPP_LIB_ID = S.SUPP_LIB_ID"
QryStr = QryStr + " Group By"
'*** 27/09/2019 DRN - Modified ExportYilmaz to use BOM_BAR_ID and Order By Bar_code and UDT.PIECE_LENGTH
'QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_PIECE_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A"
'*** 30/09/2019 DRN
'QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH"
'*** 02/10/2019 DRN - Modified ExportYilmaz Export to use FINCOL Description
'QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.FINCOL_CODE, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.CUST_REF, QI.DESCR"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.CUST_REF, QI.DESCR"
'*** 30/09/2019 DRN
'QryStr = QryStr + " Order By Bar_code, udt.piece_length desc "
QryStr = QryStr + " Order By UDT.EXTN_CODE, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH DESC "
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
Dim SEPERATOR As String
SEPERATOR = ";"
If oQuery.RecordCount > 0 Then
If bYilmazHDL Then
If SEPERATOR = "," Then
Yilmaz.Append("PROGRAM_NO,CUSTOMER_CODE,CUSTOMER_NAME,STOCK_CODE,STOCK_NAME,ORDER_NO,EXPLANATION1,EXPLANATION2,LENGTH,INCH_MM,FRAME_X,FRAME_Y,POSE_NO,TROLLEY,UNIT,LEFT_ANGLE,RIGHT_ANGLE,SIDE,CUTTED,HEIGHT,SELLER,IMAGE,PAIR,XQUANTITY,QUANTITY,CUTTED_QUANTITY")
Else
Yilmaz.Append("PROGRAM_NO;CUSTOMER_CODE;CUSTOMER_NAME;STOCK_CODE;STOCK_NAME;ORDER_NO;EXPLANATION1;EXPLANATION2;LENGTH;INCH_MM;FRAME_X;FRAME_Y;POSE_NO;TROLLEY;UNIT;LEFT_ANGLE;RIGHT_ANGLE;SIDE;CUTTED;HEIGHT;SELLER;IMAGE;PAIR;XQUANTITY;QUANTITY;CUTTED_QUANTITY")
End If
Else
If SEPERATOR = "," Then
Yilmaz.Append("PROGRAM_NO,CUSTOMER_CODE,CUSTOMER_NAME,STOCK_CODE,STOCK_NAME,ORDER_NO,EXPLANATION1,EXPLANATION2,LENGTH,INCH_MM,FRAME_X,FRAME_Y,POSE_NO,TROLLEY,UNIT,LEFT_ANGLE,RIGHT_ANGLE,SIDE,CUTTED,HEIGHT,SELLER,IMAGE,PAIR")
Else
Yilmaz.Append("PROGRAM_NO;CUSTOMER_CODE;CUSTOMER_NAME;STOCK_CODE;STOCK_NAME;ORDER_NO;EXPLANATION1;EXPLANATION2;LENGTH;INCH_MM;FRAME_X;FRAME_Y;POSE_NO;TROLLEY;UNIT;LEFT_ANGLE;RIGHT_ANGLE;SIDE;CUTTED;HEIGHT;SELLER;IMAGE;PAIR")
End If
End If
Dim PROGRAM_NO As Integer
While Not oQuery.EOF
'*** 21/01/2020 DRN - Modified ExportYilmaz to output 1 line per cut
For i = 1 To oQuery.Fields("PIECE_COUNT")
PieceStr = ""
PieceStr = PieceStr + Left(CStr(PROGRAM_NO),4) '1 --Programe_No
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("QUOTE_NUM"),12) '2 --Customer_Code
PieceStr = PieceStr + SEPERATOR
If Not IsNull(oQuery.Fields("CUST_NAME")) Then '3 --Customer_Name
PieceStr = PieceStr + Left(oQuery.Fields("CUST_NAME"),24)
End If
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_CODE"),16) '4 --Stock_Code
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_DESCR"),24) '5 --Stock_Name
PieceStr = PieceStr + SEPERATOR
'PieceStr = PieceStr + Left(oQuery.Fields("PIECE_COUNT"),6) '6 --Order_No
PieceStr = PieceStr + "1" '6 --Order_No
PieceStr = PieceStr + SEPERATOR
'*** 02/10/2019 DRN
PieceStr = PieceStr + Left(oQuery.Fields("FINCOL_DESCR"),24) '7 --Explanation1
PieceStr = PieceStr + SEPERATOR
If Not IsNull(oQuery.Fields("CUST_REF")) Then '8 --Explanation2
PieceStr = PieceStr + Left(CStr(oQuery.Fields("QTE_POS")) + "/" + Replace(oQuery.Fields("CUST_REF"),",",""),24)
Else
PieceStr = PieceStr + Left(CStr(oQuery.Fields("QTE_POS")) + "/" + Trim(Replace(oQuery.Fields("ITEM_DESCR"),",","")),24)
End If
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("PIECE_LENGTH"),8) '9
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '10 --inch_mm
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '11 --Frame_X
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '12 --Frame_Y
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '13 --pose_no
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '14 --trolley
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '15 --unit
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("CUT_1A"),2) '16 --Left_Angle
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("CUT_2A"),2) '17 --Right_Angle
'SMK no need to convert angle as 45/135 radio button converts
'PieceStr = PieceStr + oQuery.Fields("CUT_1A") '16
'PieceStr = PieceStr + Trim(CStr(Val(oQuery.Fields("CUT_1A"))-90)) '16 --Left_Angle
'PieceStr = PieceStr + ","
'PieceStr = PieceStr + oQuery.Fields("CUT_2A") '17
'PieceStr = PieceStr + Trim(CStr(Val(oQuery.Fields("CUT_2A"))-90)) '17 --Right_Angle
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '18 --Side
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '19 --Cutted
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_HEIGHT"),3) '20 --Height
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '21 --Seller, empty
PieceStr = PieceStr + SEPERATOR
'*** 13/09/2019 DRN - Add EXTN_CODE + ".bmp" to Yilmaz export for IMAGE column
'*** 20/09/2019 DRN - Add IMAGE\ directory name to Yilmaz export for IMAGE column
'PieceStr = PieceStr + "" '22 --image, empty
PieceStr = PieceStr + "IMAGE\" + oQuery.Fields("EXTN_CODE")+ ".bmp" '22 --Image
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" '23 --Pair, 0
PieceStr = PieceStr + SEPERATOR
If bYilmazHDL Then
' add defaults for XQUANTITY,QUANTITY,CUTTED_QUANTITY
PieceStr = PieceStr + "1" 'XQUANTITY
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "1" 'QUANTITY
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "0" 'CUTTED_QUANTITY
PieceStr = PieceStr + SEPERATOR
End If
Yilmaz.Append PieceStr
PROGRAM_NO = PROGRAM_NO + 1
Next i
oQuery.Next
Wend
End If
End Function
Function ExportOzcelik
Dim oQuery As Object
Dim PieceStr As String
Set oQuery = New Query
CheckSubFolderOzcelik
Set Ozcelik = New TextFile
Ozcelik.FileName = sCNCFilePath + "\Ozcelik\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".csv"
Ozcelik.Clear
Ozcelik.Open
QryStr = "Select"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR AS FINCOL_DESCR, STR(UDT.BOM_BAR_ID) as BAR_ID, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.DESCR AS ITEM_DESCR, QI.CUST_REF"
QryStr = QryStr + " From UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UDT.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UDT.QUOTE_VERS"
QryStr = QryStr + " Join Quote_Item QI On"
QryStr = QryStr + " QI.QUOTE_ID = Q.QUOTE_ID And"
QryStr = QryStr + " QI.QUOTE_ITEM_ID = UDT.QUOTE_ITEM_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " Customer C On"
QryStr = QryStr + " C.CUST_ID = Q.CUST_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC On"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID And"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID"
QryStr = QryStr + " Join EXTN E On"
QryStr = QryStr + " UDT.EXTN_ID = E.EXTN_ID And"
QryStr = QryStr + " UDT.EXTN_LIB_ID = E.EXTN_LIB_ID"
QryStr = QryStr + " Join MATERIAL M On"
QryStr = QryStr + " M.MATERIAL_ID = E.MATERIAL_ID And"
QryStr = QryStr + " M.MATERIAL_LIB_ID = E.MATERIAL_LIB_ID"
QryStr = QryStr + " Join SUPPLIER S On"
QryStr = QryStr + " E.SUPP_ID = S.SUPP_ID And"
QryStr = QryStr + " E.SUPP_LIB_ID = S.SUPP_LIB_ID"
QryStr = QryStr + " Group By"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.CUST_REF, QI.DESCR"
QryStr = QryStr + " Order By UDT.EXTN_CODE, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH DESC "
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
'Ozcelik.Append("ID,BoyNo,Boy,PrNo,Olcu,Aci1,Aci2,StokKodu,Aciklama,Gen,Yuk,Araba,Yer,Yon,DsKod,DsOlcu,PozNo,SipNo,Bayi,SevkTar,Musteri,Renk,Islem,Barkod")
Ozcelik.Append("ID;BoyNo;Boy;PrNo;Olcu;Aci1;Aci2;StokKodu;Aciklama;Gen;Yuk;Araba;Yer;Yon;DsKod;DsOlcu;PozNo;SipNo;Bayi;SevkTar;Musteri;Renk;Islem;Barkod")
Dim PROGRAM_NO, GROUP_NO, PIECE_NO As Integer
Dim BAR_ID_PREV, SEPERATOR As String
PROGRAM_NO = 1
GROUP_NO = 0
PIECE_NO = 1
BAR_ID_PREV = ""
SEPERATOR = ";"
While Not oQuery.EOF
For i = 1 To oQuery.Fields("PIECE_COUNT")
PieceStr = ""
PieceStr = PieceStr + Left(Trim(CStr(PROGRAM_NO)),4) '1 --ID
PieceStr = PieceStr + SEPERATOR
If oQuery.Fields("BAR_ID") = BAR_ID_PREV Then
GROUP_NO = GROUP_NO
PIECE_NO = PIECE_NO + 1
Else
GROUP_NO = GROUP_NO + 1
PIECE_NO = 1
End If
BAR_ID_PREV = oQuery.Fields("BAR_ID")
PieceStr = PieceStr + Left(Trim(CStr(GROUP_NO)),4) '2 --BoyNo -Number of same profile is written
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("BAR_LENGTH")*10,6) '3 --Boy -Pofile total length
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(Trim(CStr(PIECE_NO)),4) '4 --PrNo -Part number
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("PIECE_LENGTH")*10,6) '5 --Olcu -Part Length
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("CUT_1A"),4) '6 --Aci1 -Left_Angle
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("CUT_2A"),4) '7 --Aci2 -Right_Angle
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_CODE"),10) '8 --StokKodu -Profile Stock Code
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_DESCR"),20) '9 --Aciklama -Explanation
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '10 --Gen -Frame Width
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '11 --Yuk -Frame Height
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '12 --Araba -Car number
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '13 --Yer -Car shelf number
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '14 --Yon -Frame location information
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '15 --DsKod -Reinforcement Profiles Code
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '16 --DsOlcu -Reinforcement Profiles size
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(Trim(CStr(oQuery.Fields("QTE_POS"))),10) '17 --PozNo -Frame number
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(Trim(oQuery.Fields("QUOTE_NUM")),10) '18 --SipNo -Order number
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '19 --Bayi -Reseller
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '20 --SevkTar -Ship date
PieceStr = PieceStr + SEPERATOR
If Not IsNull(oQuery.Fields("CUST_NAME")) Then '21 --Musteri -Customer
PieceStr = PieceStr + Left(oQuery.Fields("CUST_NAME"),10)
End If
PieceStr = PieceStr + SEPERATOR
'PieceStr = PieceStr + "" '22 --Renk -Color
PieceStr = PieceStr + Left(Trim(oQuery.Fields("FINCOL_DESCR")),24) '22 --Renk -Color
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + "" '23 --Islem -Processing
PieceStr = PieceStr + SEPERATOR
PieceStr = PieceStr + Left(Trim(oQuery.Fields("BAR_ID")),28) '24 --Barkod -Barcode
'PieceStr = PieceStr + SEPERATOR
Ozcelik.Append PieceStr
PROGRAM_NO = PROGRAM_NO + 1
Next i
oQuery.Next
Wend
End If
End Function
Function ExportOzgenc
Dim oQuery As Object
Dim PieceStr As String
Set oQuery = New Query
CheckSubFolderOzgenc
Set Ozgenc = New TextFile
Ozgenc.FileName = sCNCFilePath + "\Ozgenc\Quote_" + QuoteNum + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".csv"
Ozgenc.Clear
Ozgenc.Open
QryStr = "Select"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR AS FINCOL_DESCR, STR(UDT.BOM_BAR_ID) as BAR_CODE, SUM(PIECE_COUNT) AS PIECE_COUNT, UDT.PIECE_LENGTH, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.DESCR AS ITEM_DESCR, QI.CUST_REF"
QryStr = QryStr + " From UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = UDT.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = UDT.QUOTE_VERS"
QryStr = QryStr + " Join Quote_Item QI On"
QryStr = QryStr + " QI.QUOTE_ID = Q.QUOTE_ID And"
QryStr = QryStr + " QI.QUOTE_ITEM_ID = UDT.QUOTE_ITEM_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " Customer C On"
QryStr = QryStr + " C.CUST_ID = Q.CUST_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC On"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID And"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID"
QryStr = QryStr + " Join EXTN E On"
QryStr = QryStr + " UDT.EXTN_ID = E.EXTN_ID And"
QryStr = QryStr + " UDT.EXTN_LIB_ID = E.EXTN_LIB_ID"
QryStr = QryStr + " Join MATERIAL M On"
QryStr = QryStr + " M.MATERIAL_ID = E.MATERIAL_ID And"
QryStr = QryStr + " M.MATERIAL_LIB_ID = E.MATERIAL_LIB_ID"
QryStr = QryStr + " Join SUPPLIER S On"
QryStr = QryStr + " E.SUPP_ID = S.SUPP_ID And"
QryStr = QryStr + " E.SUPP_LIB_ID = S.SUPP_LIB_ID"
QryStr = QryStr + " Group By"
QryStr = QryStr + " UDT.QUOTE_NUM, C.CUST_NAME, M.MATERIAL_CODE, S.SUPP_COMP_NAME, UDT.EXTN_CODE, FC.DESCR, UDT.EXTN_DESCR, UDT.EXTN_HEIGHT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH, CUT_1A, CUT_2A, BAR_LENGTH, QI.QTE_POS, QI.CUST_REF, QI.DESCR"
QryStr = QryStr + " Order By UDT.EXTN_CODE, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH DESC "
'Clipboard QryStr
oQuery.Close
oQuery.SQL = QryStr
oQuery.Open
If oQuery.RecordCount > 0 Then
'Below 2 lines for testing csv files
'Ozgenc.Append("WORK#,PIECE_ID,WINDOW#,PIECE_POSITION,OPERATION,TROLLEY#,SHELF#,PROFILE_CODE,PIECE_LENGTH,LENGTH-6mm(welding space),PERPENDICULAR_PROFILE_LENGTH,COLOR,SELLER_NAME,BUYER_NAME,DELIVERY_DATE,PROFILE_BAR#,ORDER#,LEFT_ANGLE,RIGHT_ANGLE,PROFILE_NAME,NOTE,CUSTOM#1,CUSTOM#2,CUSTOM#3,IMGPATH,BARCODE#,BARLENGTH,LASTPIECESIZE(waste profile),LASTPIECE ID")
'Ozgenc.Append("WORK#;PIECE_ID;WINDOW#;PIECE_POSITION;OPERATION;TROLLEY#;SHELF#;PROFILE_CODE;PIECE_LENGTH;LENGTH-6mm(welding space);PERPENDICULAR_PROFILE_LENGTH;COLOR;SELLER_NAME;BUYER_NAME;DELIVERY_DATE;PROFILE_BAR#;ORDER#;LEFT_ANGLE;RIGHT_ANGLE;PROFILE_NAME;NOTE;CUSTOM#1;CUSTOM#2;CUSTOM#3;IMGPATH;BARCODE#;BARLENGTH;LASTPIECESIZE(waste profile);LASTPIECE ID")
Dim BAR_NO, PIECE_NO As Integer
Dim BAR_CODE_PREV, vDelimiter As String
BAR_NO = 0
BAR_CODE_PREV = ""
vDelimiter = ";"
PIECE_NO = 1
While Not oQuery.EOF
For i = 1 To oQuery.Fields("PIECE_COUNT")
PieceStr = ""
'A --WORK# (order#) -String- Sent job order number. May be same as the file name (0001.CSV ISNO=0)
PieceStr = PieceStr + Left(Trim(oQuery.Fields("QUOTE_NUM")),4)
PieceStr = PieceStr + vDelimiter
'B --PIECE_ID -Integer- Sequence no. ( 1…9999)
PieceStr = PieceStr + Left(Trim(CStr(PIECE_NO)),4)
PieceStr = PieceStr + vDelimiter
'C --WINDOW# (pos) -Integer- ( 1…9999)
PieceStr = PieceStr + Left(Trim(oQuery.Fields("QTE_POS")),4)
PieceStr = PieceStr + vDelimiter
'D --PIECE_POSITION -String- (Top, bottom, left, right)
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'E --OPERATION -String- 1=Water discharge, 2=Arm location, 3=Hinge, 4=D.O. Hinge, 5=Single opening left , 6=Single opening right, 7=Double opening left, 8=Double opening right, 9=Transom opening
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'F --TROLLEY# -Integer- Cart no ( 1…9999)
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'G --SHELF# -Integer- Cart location no ( 1…9999)
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'H --PROFILE_CODE -String- Profile stock code
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_CODE"),10)
PieceStr = PieceStr + vDelimiter
'I --LENGTH -Integer- Cutting Dimension, E.g: 1506.5
PieceStr = PieceStr + Left(oQuery.Fields("PIECE_LENGTH"),6)
PieceStr = PieceStr + vDelimiter
'J --LENGTH -6 mm (welding space) -Integer- Net cutting dimension; E.g:1500 (No welding margin)
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'K --PERPENDICULAR PROFILE LENGTH -Integer- Other dimension; E.g: 2006 (2000 x 1500 ) Frame
PieceStr = PieceStr + "0"
PieceStr = PieceStr + vDelimiter
'L --COLOUR
PieceStr = PieceStr + Left(oQuery.Fields("FINCOL_DESCR"),10)
PieceStr = PieceStr + vDelimiter
'M --SELLER NAME -String- Company Name
PieceStr = PieceStr + Left(oQuery.Fields("SUPP_COMP_NAME"),8)
PieceStr = PieceStr + vDelimiter
'N --BUYER NAME -String- Customer Name
If IsNull(oQuery.Fields("CUST_NAME")) Then
PieceStr = PieceStr + ""
Else
PieceStr = PieceStr + Left(oQuery.Fields("CUST_NAME"),8)
End If
PieceStr = PieceStr + vDelimiter
'O --DELIVERY DATE -String- Shipment Date
PieceStr = PieceStr + Format(Date,"dd/mm/yyyy")
PieceStr = PieceStr + vDelimiter
'P --PROFILE BAR# -Integer- Cutted bar number
If oQuery.Fields("BAR_CODE") = BAR_CODE_PREV Then
BAR_NO = BAR_NO
Else
BAR_NO = BAR_NO + 1
End If
BAR_CODE_PREV = oQuery.Fields("BAR_CODE")
PieceStr = PieceStr + Left(Trim(CStr(BAR_NO)),4)
PieceStr = PieceStr + vDelimiter
'Q --ORDER#
PieceStr = PieceStr + Left(Trim(oQuery.Fields("QUOTE_NUM")),4)
PieceStr = PieceStr + vDelimiter
'R --LEFT ANGLE -Integer- Left angle
PieceStr = PieceStr + Left(oQuery.Fields("CUT_1A"),4)
PieceStr = PieceStr + vDelimiter
'S --RIGHT ANGLE -Integer- Right angle
PieceStr = PieceStr + Left(oQuery.Fields("CUT_2A"),4)
PieceStr = PieceStr + vDelimiter
'T --PROFILE NAME -String- Profile description
PieceStr = PieceStr + Left(oQuery.Fields("EXTN_DESCR"),20)
PieceStr = PieceStr + vDelimiter
'U --NOTE
PieceStr = PieceStr + vDelimiter
'V --CUSTOM PARAMETER 1
PieceStr = PieceStr + vDelimiter
'W --CUSTOM PARAMETER 2
PieceStr = PieceStr + vDelimiter
'X --CUSTOM PARAMETER 3
PieceStr = PieceStr + vDelimiter
'Y --IMGPATH
PieceStr = PieceStr + "\Images\" + Left(oQuery.Fields("EXTN_CODE"),10) + ".jpg"
PieceStr = PieceStr + vDelimiter
'Z --BARCODE#
PieceStr = PieceStr + Left(oQuery.Fields("BAR_CODE"),20)
PieceStr = PieceStr + vDelimiter
'AA --BARLENGTH
PieceStr = PieceStr + Left(oQuery.Fields("BAR_LENGTH"),6)
PieceStr = PieceStr + vDelimiter
'AB --LASTPIECE SIZE
PieceStr = PieceStr + vDelimiter
'AC --LASTPIECE ID
PieceStr = PieceStr + vDelimiter
PIECE_NO = PIECE_NO + 1
Ozgenc.Append PieceStr
Next i
oQuery.Next
Wend
End If
End Function
Function StrZero(StrTxt, StrLength, Position)
For i = 0 To StrLength
StrZero = StrZero + "0"
Next i
If Position = "LEFT" Then
StrZero = Left(StrTxt + StrZero, StrLength)
Else
StrZero = Right(StrZero + StrTxt, StrLength)
End If
End Function
Function CreateCheckINI
sINIFileName = AppPath+"\V6_Sawlink.ini"
sCNCFilePath = ReadINIString(sINIFileName, "CNCFilePath", "CNCFilePath","No INI")
sINIBrand = ReadINIString(sINIFileName, "INIBrand", "INIBrand","No Brand")
If sCNCFilePath = "No INI" Then
sCNCFilePath = "C:\V6_Sawlink" 'Origional default file path
WriteINIString(sINIFileName, "CNCFilePath", "CNCFilePath", sCNCFilePath) 'Create ini file
Else
sCNCFilePath = ReadINIString(sINIFileName, "CNCFilePath", "CNCFilePath", sINIFileName)
End If
'*** 11/03/2021 DRN - Add supplier brand
If sINIBrand = "No Brand" Then
Dim qry As String
Dim supplier_code As Variant
qry = "SELECT TOP 1 S.SUPP_CODE FROM EXTN E, SUPPLIER S WHERE S.SUPP_LIB_ID = E.SUPP_LIB_ID AND S.SUPP_ID = E.SUPP_ID GROUP BY S.SUPP_CODE ORDER BY COUNT(S.SUPP_CODE) DESC"
supplier_code = GetQuery(qry)
If Not(IsNull(supplier_code)) Then
sINIBrand = supplier_code(0,0)
WriteINIString(sINIFileName, "INIBrand", "INIBrand", sINIBrand)
End If
End If
End Function
Function ChangeINI
WriteINIString(sINIFileName, "CNCFilePath", "CNCFilePath", sCNCFilePath) 'Update ini file
'*** 11/03/2021 DRN - Add supplier brand
WriteINIString(sINIFileName, "INIBrand", "INIBrand", sINIBrand)
End Function
Function CheckFolder
On Error GoTo ErrHandler
ChDir sCNCFilePath
Exit Function
ErrHandler:
MkDir sCNCFilePath
Resume Next
End Function
Function CheckSubFolderElumatec
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Elumatec"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Elumatec"
Resume Next
End Function
Function CheckSubFolderFOM
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Fom"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Fom"
Resume Next
End Function
Function CheckSubFolderMecal
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Mecal"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Mecal"
Resume Next
End Function
Function CheckSubFolderEmmegi
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Emmegi"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Emmegi"
Resume Next
End Function
Function CheckSubFolderPertici
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Pertici"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Pertici"
Resume Next
End Function
Function CheckSubFolderTiger
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Tiger"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Tiger"
Resume Next
End Function
Function CheckSubFolderYilmaz
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Yilmaz"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Yilmaz"
Resume Next
End Function
Function CheckSubFolderOzcelik
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Ozcelik"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Ozcelik"
Resume Next
End Function
Function CheckSubFolderOzgenc
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\Ozgenc"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\Ozgenc"
Resume Next
End Function
Function CheckSubFolderNCX
On Error GoTo ErrHandler
ChDir sCNCFilePath + "\NCX"
Exit Function
ErrHandler:
MkDir sCNCFilePath + "\NCX"
Resume Next
End Function
Function StrSpace(StrTxt, StrLength, Position)
Dim I As Integer
For i = 0 To StrLength
StrSpace = StrSpace + " "
Next i
If Position = "LEFT" Then
StrSpace = Left(StrTxt + StrSpace, StrLength)
Else
StrSpace = Right(StrSpace + StrTxt, StrLength)
End If
End Function
'FOM export bar details
Function GetBarDetails
Dim XmlDetail As Variant
QryStr = "Select"
QryStr = QryStr + " UDT.EXTN_CODE,"
QryStr = QryStr + " UDT.FINCOL_CODE,"
QryStr = QryStr + " FC.DESCR,"
QryStr = QryStr + " COUNT(UDT.NEW_BAR_QTY) As QTY"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC ON"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID AND"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID"
QryStr = QryStr + " Group By"
QryStr = QryStr + " UDT.EXTN_CODE,"
QryStr = QryStr + " UDT.FINCOL_CODE,"
QryStr = QryStr + " FC.DESCR"
'Clipboard QryStr
XmlDetail = GetQuery(QryStr)
For i = 0 To UBound(XmlDetail)
oXMLStruct.Append("")
oXMLStruct.Append("" + XmlDetail(i,0) + "")
oXMLStruct.Append("" + XmlDetail(i,1) + "")
oXMLStruct.Append("" + XmlDetail(i,2) + "")
oXMLStruct.Append("" + XmlDetail(i,3) + "")
oXMLStruct.Append("")
Next i
End Function
'FOM export piece details
Function GetPieceDetails
QryStr = "Select Distinct"
QryStr = QryStr + " UDT.EXTN_CODE," '0
QryStr = QryStr + " UDT.EXTN_DESCR," '1
QryStr = QryStr + " UDT.FINCOL_CODE," '2
QryStr = QryStr + " FC.DESCR," '3
QryStr = QryStr + " UDT.BAR_LENGTH," '4
QryStr = QryStr + " UDT.EXTN_HEIGHT," '5
QryStr = QryStr + " UDT.BOM_BAR_ID," '6
QryStr = QryStr + " UDT.CLASSIF_CODE" '7
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " FINCOL FC ON"
QryStr = QryStr + " UDT.FINCOL_LIB_ID = FC.FINCOL_LIB_ID AND"
QryStr = QryStr + " UDT.FINCOL_ID = FC.FINCOL_ID"
QryStr = QryStr + " Order By"
QryStr = QryStr + " UDT.EXTN_CODE,"
QryStr = QryStr + " UDT.EXTN_DESCR,"
QryStr = QryStr + " UDT.FINCOL_CODE,"
QryStr = QryStr + " FC.DESCR"
'Clipboard QryStr
XmlDetail = GetQuery(QryStr)
For i = 0 To UBound(XmlDetail)
oXMLStruct.Append("")
'*** 11/03/2021 DRN - Add supplier brand
'oXMLStruct.Append("COMPANY")
oXMLStruct.Append("" + sINIBrand + "")
'change system name below
oXMLStruct.Append("" + XmlDetail(i,7) + "")
oXMLStruct.Append("" + XmlDetail(i,0) + "")
oXMLStruct.Append("" + XmlDetail(i,1) + "")
oXMLStruct.Append("" + XmlDetail(i,2) + "")
oXMLStruct.Append("" + XmlDetail(i,3) + "")
oXMLStruct.Append("" + XmlDetail(i,4) + "")
oXMLStruct.Append("1")
oXMLStruct.Append("" + CStr(Round(XmlDetail(i,5),3)) + "")
GetCutDetails(XmlDetail(i,6))
oXMLStruct.Append("")
Next i
End Function
'FOM export cut details
Function GetCutDetails(BomBarID)
Dim CutDetails As Variant
Dim Barcode As String
Dim Padding As String 'Padding for barcode. Will pad the front of the barcode out to 12 characters using 0
Padding = "000000000000"
QryStr = "Select"
QryStr = QryStr + " CUT_1A," '0
QryStr = QryStr + " CUT_2A," '1
QryStr = QryStr + " PIECE_LENGTH," '2
QryStr = QryStr + " FINCOL_CODE," '3
QryStr = QryStr + " EXTN_WIDTH," '4
QryStr = QryStr + " QUOTE_ITEM_ID," '5
QryStr = QryStr + " EXTN_HEIGHT," '6
QryStr = QryStr + " POSITION" '7
QryStr = QryStr + " From" '8
QryStr = QryStr + " UDT_QTE_MAT_QTY" '9
QryStr = QryStr + " Where BOM_BAR_ID = '" + BomBarID + "'" '10
'Clipboard QryStr
CutDetails = GetQuery(QryStr)
For J = 0 To UBound(CutDetails)
QryStr = "Select Distinct Q.JOB_NUM, Q.QUOTE_NUM, QI.QTE_POS, QI.DESCR"
QryStr = QryStr + " From QUOTE_ITEM QI"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = QI.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = QI.QUOTE_VERS_STOP"
QryStr = QryStr + " Where QUOTE_ITEM_ID = '" + CutDetails(J,5) + "'"
'Clipboard QryStr
QteDetail = GetQuery(QryStr)
If Not IsNull QteDetail Then
For K = 0 To UBound(QteDetail)
If Not IsNull QteDetail(K,0) Then
JobNum = QteDetail(K,0)
Else
JobNum = ""
End If
QteNum = QteDetail(K,1)
QteItemNum = QteDetail(K,2)
If Not IsNull QteDetail(K,3) Then
'*** 31/08/2020 DRN - Modified to strip escape characters from FOM XML output
'QteItemDescr = QteDetail(K,3)
'QteItemDescr = Replace(Replace(Replace(Replace(QteDetail(K,3),"'",""),"&",""),"<",""),">","")
'*** 17/09/2021 DRN - Modified to strip degree character ° from FOM XML output
QteItemDescr = Replace(Replace(Replace(Replace(Replace(QteDetail(K,3),"'",""),"&",""),"°",""),"<",""),">","")
Else
QteItemDescr = ""
End If
Next K
End If
oXMLStruct.Append("+")
oXMLStruct.Append("" + CutDetails(J,0) + "")
oXMLStruct.Append("" + CutDetails(J,1) + "")
If sCutAngle = "135" Then
'when using 135deg cuts OL is cut lenght less the adjacent of the angle
oXMLStruct.Append("" + GetIntLength(CutDetails(J,2), CutDetails(J,6), CutDetails(J,0), CutDetails(J,1)) + "
")
'when using 135deg cuts IL is the long point on the deck
oXMLStruct.Append("" + CutDetails(J,2) + "")
Else
'when using 45deg cuts OL is cut lenght off the deck
oXMLStruct.Append("" + CutDetails(J,2) + "
")
'when using 45deg cuts IL is the cut legth on the deck
oXMLStruct.Append("" + GetIntLength(CutDetails(J,2), CutDetails(J,6), CutDetails(J,0), CutDetails(J,1)) + "")
End If
'*** 15/08/2023 DRN - Updated FOM extract BCOD, DESC, LBL
'oXMLStruct.Append("000000000000")
Barcode = Padding + BomBarID + CStr(J)
Barcode = Right(Barcode,14)
oXMLStruct.Append(""+ Barcode + "")
oXMLStruct.Append(""+ "Pos:" + CutDetails(J,7) + "")
oXMLStruct.Append("" + CutDetails(J,2) + " mm" + "")
oXMLStruct.Append("" + "Job#" + JobNum + "")
oXMLStruct.Append("" + "Qte#" + QteNum + "/Item#"+ QteItemNum + "")
oXMLStruct.Append("" + QteItemDescr + "")
oXMLStruct.Append("")
Next J
End Function
Function GetEmmegiBarDetails
Dim EmmegiDetail As Variant
Dim ExtnDescr As String
Dim BarCount As Integer
Dim OldExtnCode As String
Dim SeriesStr As String
QryStr = "Select DISTINCT"
'*** 11/03/2021 DRN - Add supplier brand
'QryStr = QryStr + " CLASSIF_CODE,"
QryStr = QryStr + " '" + sINIBrand + "',"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " EXTN_DESCR,"
QryStr = QryStr + " EXTN_WIDTH,"
QryStr = QryStr + " EXTN_HEIGHT,"
QryStr = QryStr + " EXTN_ENDTRIM,"
QryStr = QryStr + " FINCOL_CODE,"
QryStr = QryStr + " BOM_BAR_ID,"
QryStr = QryStr + " BAR_LENGTH"
QryStr = QryStr + " From UDT_QTE_MAT_QTY"
QryStr = QryStr + " ORDER By"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " FINCOL_CODE"
'Clipboard QryStr
EmmegiDetail = GetQuery(QryStr)
For K = 0 To UBound(EmmegiDetail)
If Len(EmmegiDetail(K,2)) > 20 Then
ExtnDescr = Left(EmmegiDetail(K,2),20)
Else
ExtnDescr = EmmegiDetail(K,2)
End If
'*** 07/01/2020 DRN - Add SeriesStr to match Emmegi USTD requirements
'S – profile description
'S;Series;Code;ExtColor;Description;Height;Width;CutRef;LThickBevelledCut;RThickBevelledCut;LThickWedgeCut;RThickWedgeCut;CounterBlockH;FrontScrap;EndScrap;IntColor;Mode;View;Barlength;Multibar
SeriesStr = "S;"
SeriesStr = SeriesStr + Left(EmmegiDetail(K,0),7) 'Series
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + EmmegiDetail(K,1) 'Code
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + EmmegiDetail(K,6) 'ExtColor
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + ExtnDescr 'Description
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + EmmegiDetail(K,4) 'Height
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + EmmegiDetail(K,3) 'Width
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + EmmegiDetail(K,4) 'CutRef
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'LThickBevelledCut
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'RThickBevelledCut
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'LThickWedgeCut
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'RThickWedgeCut
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'CounterBlockH
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'FrontScrap
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'EndScrap
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'IntColor
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'Mode
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'View
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + CStr(EmmegiDetail(K,8)) 'Barlength
SeriesStr = SeriesStr + ";"
SeriesStr = SeriesStr + "" 'Multibar
'EmmegiSawfile.Append("S;" + Left(EmmegiDetail(K,0),7) + ";" + EmmegiDetail(K,1) + ";" + EmmegiDetail(K,6) + ";" + ExtnDescr + ";" + EmmegiDetail(K,4) + ";" + EmmegiDetail(K,3) + ";" + EmmegiDetail(K,4) + ";;;;;;" + CStr(EmmegiDetail(K,8)) + ";;")
EmmegiSawfile.Append(SeriesStr)
If EmmegiDetail(K,1) <> OldExtnCode Then
BarCount = 1
OldExtnCode = EmmegiDetail(K,1)
Else
BarCount = BarCount + 1
End If
'GetEmmegiBar(BOM_BAR_ID, BarCount)
GetEmmegiBar(EmmegiDetail(K,7),BarCount)
GetEmmegiPieces(EmmegiDetail(K,7),BarCount)
Next K
End Function
Function GetEmmegiPieces(BOM_BAR_ID, BarCount)
Dim PieceDetail As Variant
Dim PieceStr As String
QryStr = "Select Distinct"
QryStr = QryStr + " PIECE_LENGTH,"
QryStr = QryStr + " COUNT(PIECE_LENGTH),"
QryStr = QryStr + " CUT_1A,"
QryStr = QryStr + " CUT_1B,"
QryStr = QryStr + " CUT_2A,"
QryStr = QryStr + " CUT_2B,"
QryStr = QryStr + " POSITION,"
'*** 20/12/2019 DRN - Fix GetEmmegiPieces
'QryStr = QryStr + " QUOTE_ITEM_ID"
QryStr = QryStr + " QUOTE_ITEM_ID,"
QryStr = QryStr + " BAR_LENGTH"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY"
QryStr = QryStr + " Where BOM_BAR_ID = '" + BOM_BAR_ID + "'
'*** 20/12/2019 DRN - Fix GetEmmegiPieces
'QryStr = QryStr + " Group By PIECE_LENGTH, CUT_1A, CUT_1B, CUT_2A, CUT_2B, POSITION, QUOTE_ITEM_ID"
QryStr = QryStr + " Group By PIECE_LENGTH, CUT_1A, CUT_1B, CUT_2A, CUT_2B, POSITION, QUOTE_ITEM_ID, BAR_LENGTH"
'Clipboard QryStr
PieceDetail = GetQuery(QryStr)
For i = 0 To UBound(PieceDetail)
QryStr = "Select Distinct Q.JOB_NUM, Q.QUOTE_NUM, QI.QTE_POS, QI.DESCR"
QryStr = QryStr + " From QUOTE_ITEM QI"
QryStr = QryStr + " Join Quote Q On"
QryStr = QryStr + " Q.QUOTE_ID = QI.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = QI.QUOTE_VERS_STOP"
QryStr = QryStr + " Where QUOTE_ITEM_ID = '" + PieceDetail(i,7) + "'"
QteDetail = GetQuery(QryStr)
If Not IsNull QteDetail Then
For J = 0 To UBound(QteDetail)
If Not IsNull QteDetail(J,0) Then
JobNum = QteDetail(J,0)
Else
JobNum = ""
End If
QteNum = QteDetail(J,1)
QteItemNum = QteDetail(J,2)
If Not IsNull QteDetail(J,3) Then
QteItemDescr = QteDetail(J,3)
Else
QteItemDescr = ""
End If
Next J
End If
'P – piece description
'P;IdPiece;Quantity;Length;LAngleHead;RAngleHead;IdMultiBar;OriginalRef;IdStyle;Customer;IsNoseToNose;PosQuote;LThickBevelledCut;RThickBevelledCut;LBladeAngle;RBladeAngle;BarCode;Info1;Info2;Info3;Info4;Info5;StructId
PieceStr = "P;"
PieceStr = PieceStr + CStr(BarCount) 'Bar Id
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,1)) 'Quantity
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,0)) 'Length
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,2)) 'L Angle Head
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,4)) 'R Angle Head
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Multibar
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Original Ref
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,6)) 'Position
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Customer Field Not Used
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Is Nose To Nose
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Pos Quote
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'L Angle Bevell Cut
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'R Angle Bevell Cut
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,3)) 'L Blade Angle
PieceStr = PieceStr + ";"
PieceStr = PieceStr + CStr(PieceDetail(i,5)) 'R Blade Angle
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Piece ID (Bar Code)
PieceStr = PieceStr + ";"
PieceStr = PieceStr + JobNum 'Info 1
PieceStr = PieceStr + ";"
PieceStr = PieceStr + QteNum 'Info 2
PieceStr = PieceStr + ";"
PieceStr = PieceStr + QteItemNum 'Info 3
PieceStr = PieceStr + ";"
PieceStr = PieceStr + QteItemDescr 'Info 4
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "" 'Info 5
PieceStr = PieceStr + ";"
PieceStr = PieceStr + "1" 'View
EmmegiSawfile.Append PieceStr
Next i
End Function
Function GetEmmegiBar(BOM_BAR_ID, BarCount)
Dim BarDetail As Variant
Dim BarStr As String
QryStr = "Select Distinct"
QryStr = QryStr + " BOM_BAR_ID,"
QryStr = QryStr + " COUNT(BOM_BAR_ID),"
QryStr = QryStr + " BAR_LENGTH"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY"
QryStr = QryStr + " Where BOM_BAR_ID = '" + BOM_BAR_ID + "'
QryStr = QryStr + " Group By BOM_BAR_ID, BAR_LENGTH "
'Clipboard QryStr
BarDetail = GetQuery(QryStr)
'B – Bar description
'B;IdBar;Quantity;Length;MultiBar;IsOffCut;IdOffCut;OffCutLength
BarStr = "B;"
BarStr = BarStr + CStr(BarDetail(0,0)) 'Bar Id
BarStr = BarStr + ";"
'*** 16/09/2019 DRN
'BarStr = BarStr + CStr(BarDetail(0,1)) 'Quantity
BarStr = BarStr + "1" 'Quantity
BarStr = BarStr + ";"
BarStr = BarStr + CStr(BarDetail(0,2)) 'Length
BarStr = BarStr + ";"
BarStr = BarStr + "" 'MultiBar
BarStr = BarStr + ";"
BarStr = BarStr + "" 'IsOffCut
BarStr = BarStr + ";"
BarStr = BarStr + "" 'IDOffCut
BarStr = BarStr + ";"
BarStr = BarStr + "" 'Offcut Length
EmmegiSawfile.Append BarStr
End Function
Function GetPerticiBarDetails
Dim PerticiDetail As Variant
Dim ExtnDescr As String
Dim BarCount As Integer
Dim OldExtnCode As String
Dim SeriesStr As String
QryStr = "Select DISTINCT DENSE_RANK() OVER (ORDER BY BAR_OFFCUT, BOM_BAR_ID) As BAR_NO,"
QryStr = QryStr + " '" + sINIBrand + "',"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " EXTN_DESCR,"
QryStr = QryStr + " EXTN_WIDTH,"
QryStr = QryStr + " EXTN_HEIGHT,"
QryStr = QryStr + " EXTN_ENDTRIM,"
QryStr = QryStr + " FINCOL_CODE,"
QryStr = QryStr + " BOM_BAR_ID,"
QryStr = QryStr + " BAR_LENGTH,"
QryStr = QryStr + " BOM_CUTPLAN_ID,"
QryStr = QryStr + " BAR_OFFCUT"
QryStr = QryStr + " From UDT_QTE_MAT_QTY"
QryStr = QryStr + " ORDER By"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " BOM_CUTPLAN_ID,"
QryStr = QryStr + " FINCOL_CODE"
'Clipboard QryStr
PerticiDetail = GetQuery(QryStr)
For K = 0 To UBound(PerticiDetail)
SeriesStr = "B" 'Record identifier
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + PerticiDetail(K,2) 'Profile Code
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + Left(PerticiDetail(K,7),8) 'ExtColor
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + "1" 'Bars Together
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + CStr(PerticiDetail(K,9)*10) 'Barlength
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + "" 'Reference1
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + "" 'Reference2
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + "" 'Shutter slats to cut together
SeriesStr = SeriesStr + ","
SeriesStr = SeriesStr + CStr(PerticiDetail(K,5)) 'Profile thickness
PerticiSawfile.Append(SeriesStr)
GetPerticiPieces(PerticiDetail(K,8))
Next K
End Function
Function GetPerticiPieces(BOM_BAR_ID)
Dim PieceDetail As Variant
Dim PieceStr As String
QryStr = "Select "
QryStr = QryStr + " DENSE_RANK() OVER (ORDER BY UDT.BAR_OFFCUT, UDT.BOM_BAR_ID) As BAR_NO,"
QryStr = QryStr + " UDT.EXTN_CODE,"
QryStr = QryStr + " UDT.PIECE_LENGTH,"
QryStr = QryStr + " COUNT(UDT.PIECE_LENGTH) AS QTY,"
QryStr = QryStr + " UDT.CUT_1A,"
QryStr = QryStr + " UDT.CUT_1B,"
QryStr = QryStr + " UDT.CUT_2A,"
QryStr = QryStr + " UDT.CUT_2B,"
QryStr = QryStr + " UDT.BAR_LENGTH,"
QryStr = QryStr + " UDT.BAR_OFFCUT,"
QryStr = QryStr + " Q.QUOTE_NUM,"
QryStr = QryStr + " Q.QUOTE_VERS,"
QryStr = QryStr + " REPLACE(Q.QUOTE_TITLE,',','') AS QUOTE_TITLE,"
QryStr = QryStr + " QI.QTE_POS,"
QryStr = QryStr + " REPLACE(QI.DESCR,',','') AS DESCR"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY UDT"
QryStr = QryStr + " JOIN QUOTE_ITEM QI ON"
QryStr = QryStr + " UDT.QUOTE_ITEM_ID = QI.QUOTE_ITEM_ID"
QryStr = QryStr + " JOIN QUOTE Q ON"
QryStr = QryStr + " Q.QUOTE_ID = QI.QUOTE_ID And"
QryStr = QryStr + " Q.QUOTE_VERS = QI.QUOTE_VERS_STOP"
QryStr = QryStr + " Where BOM_BAR_ID = '" + BOM_BAR_ID + "'
QryStr = QryStr + " Group By "
QryStr = QryStr + " UDT.BOM_BAR_ID, UDT.BAR_LENGTH, UDT.BAR_OFFCUT, UDT.PIECE_LENGTH, UDT.EXTN_CODE, UDT.CUT_1A, UDT.CUT_1B, UDT.CUT_2A, UDT.CUT_2B, UDT.QTE_POS,"
QryStr = QryStr + " Q.QUOTE_NUM, Q.QUOTE_VERS, Q.QUOTE_TITLE, QI.QTE_POS, QI.DESCR"
QryStr = QryStr + " Order By "
QryStr = QryStr + " UDT.EXTN_CODE,UDT.BAR_OFFCUT, UDT.BOM_BAR_ID, UDT.PIECE_LENGTH ASC, UDT.QTE_POS, QTY"
'Clipboard QryStr
PieceDetail = GetQuery(QryStr)
For i = 0 To UBound(PieceDetail)
PieceStr = "P" 'Record identifier
PieceStr = PieceStr + ","
PieceStr = PieceStr + CStr(PieceDetail(I,2)*10) 'External Length
PieceStr = PieceStr + ","
PieceStr = PieceStr + "0" 'Internal Length
PieceStr = PieceStr + ","
PieceStr = PieceStr + Right("0000" + CStr(PieceDetail(I,4)*10),4) 'L Blade Angle
PieceStr = PieceStr + ","
PieceStr = PieceStr + Right("0000" + CStr(PieceDetail(I,6)*10),4) 'R Blade Angle
PieceStr = PieceStr + ","
PieceStr = PieceStr + CStr(PieceDetail(I,3)) 'Quantity
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Carriage Number
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Slot Number
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Unique Piece Number
PieceStr = PieceStr + ","
PieceStr = PieceStr + Left(PieceDetail(I,14),40) 'Piece Identification
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Special Cut
PieceStr = PieceStr + ","
PieceStr = PieceStr + CStr(PieceDetail(I,10)) 'Order
PieceStr = PieceStr + ","
PieceStr = PieceStr + Left(PieceDetail(I,12),30) 'Customer
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Pos.Plac/Crossp.
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Pos.Plac/Crossp.
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Pos.Plac/Crossp.
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Reinforce
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Fixing
PieceStr = PieceStr + ","
PieceStr = PieceStr + CStr(PieceDetail(I,10)) +"/"+ CStr(PieceDetail(I,13)) 'Type Code
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Holes H2o
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Holes H2o
PieceStr = PieceStr + ","
PieceStr = PieceStr + CStr(PieceDetail(I,13)) 'Holes H2o
PieceStr = PieceStr + ","
PieceStr = PieceStr + PieceDetail(I,1) + ".PCX" 'Notes / Graphic label filename .PCX
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Q1
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Q2
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Q3
PieceStr = PieceStr + ","
PieceStr = PieceStr + "" 'Q4
PerticiSawfile.Append PieceStr
Next i
End Function
'cut deduction formula
Function GetIntLength(sIntLen, BarHeight, LeftAngle, RightAngle)
Dim Deduction As Double
Dim LeftDeduction As Double
Dim RightDeduction As Double
If sCutAngle = "135" Then
If LeftAngle <> "90" Then
'*** 10/09/2019 DRN - change to left and right deduction calculation.
'LeftDeduction = BarHeight/(Tan(LeftAngle*degs)*-1)
LeftDeduction = Abs(BarHeight/(Tan(LeftAngle*degs)*-1))
Else
LeftDeduction = 0
End If
If RightAngle <> "90" Then
'*** 10/09/2019 DRN - change to left and right deduction calculation.
'RightDeduction = BarHeight/(Tan(RightAngle*degs)*-1)
RightDeduction = Abs(BarHeight/(Tan(RightAngle*degs)*-1))
Else
RightDeduction = 0
End If
Else
If LeftAngle <> "90" Then
'*** 10/09/2019 DRN - change to left and right deduction calculation.
'LeftDeduction = BarHeight/Tan(LeftAngle*degs)
LeftDeduction = Abs(BarHeight/Tan(LeftAngle*degs))
Else
LeftDeduction = 0
End If
If RightAngle <> "90" Then
'*** 10/09/2019 DRN - change to left and right deduction calculation.
'RightDeduction = BarHeight/Tan(RightAngle*degs)
RightDeduction = Abs(BarHeight/Tan(RightAngle*degs))
Else
RightDeduction = 0
End If
End If
Deduction = LeftDeduction + RightDeduction
GetIntLength = Round((sIntLen - Deduction),2)
End Function
Sub get_bom_pieces
Set Pieces = New Query
QryStr = " Select"
QryStr = QryStr + " Q.QUOTE_NUM," '0
QryStr = QryStr + " QI.QTE_POS," '1
QryStr = QryStr + " BP.PART_CODE," '2
QryStr = QryStr + " BP.CUT_SPEC1," '3
QryStr = QryStr + " BP.PIECE_LENGTH * 25.40," '4
QryStr = QryStr + " BP.POS_INSTANCE_VALUE," '5
QryStr = QryStr + " 0 as BAR_LENGTH," '6
QryStr = QryStr + " BP.POS_INSTANCE_VALUE," '7
QryStr = QryStr + " 0 as BOM_BAR_ID," '8
QryStr = QryStr + " BP.CUT_SPEC2," '9
QryStr = QryStr + " BP.EXTN_LIB_ID," '10
QryStr = QryStr + " BP.EXTN_ID," '11
QryStr = QryStr + " BP.FINCOL_LIB_ID," '12
QryStr = QryStr + " BP.FINCOL_ID," '13
QryStr = QryStr + " BP.BOM_PIECE_ID," '14
QryStr = QryStr + " BP.PIECE_LENGTH," '15
QryStr = QryStr + " BP.PIECE_COUNT," '16
QryStr = QryStr + " BP.INSTANCE_IDENT," '17
QryStr = QryStr + " 0 As BAR_ID," '18
QryStr = QryStr + " C.CUST_CODE," '19
QryStr = QryStr + " QI.DESCR" '20
QryStr = QryStr + " From"
QryStr = QryStr + " QUOTE Q"
QryStr = QryStr + " Join"
QryStr = QryStr + " QUOTE_ITEM QI On"
QryStr = QryStr + " Q.QUOTE_ID = QI.QUOTE_ID And "
QryStr = QryStr + " Q.QUOTE_VERS = QI.QUOTE_VERS_STOP"
QryStr = QryStr + " Join"
QryStr = QryStr + " BOM_PIECE BP On"
QryStr = QryStr + " QI.QUOTE_ITEM_ID = BP.QUOTE_ITEM_ID"
QryStr = QryStr + " Join"
QryStr = QryStr + " EXTN E On"
QryStr = QryStr + " BP.EXTN_ID = E.EXTN_ID And "
QryStr = QryStr + " BP.EXTN_LIB_ID = E.EXTN_LIB_ID"
'*** 30/09/2020 DRN - Material Filter
QryStr = QryStr + " Join"
QryStr = QryStr + " MATERIAL M On"
QryStr = QryStr + " M.MATERIAL_ID = E.MATERIAL_ID And "
QryStr = QryStr + " M.MATERIAL_LIB_ID = E.MATERIAL_LIB_ID"
QryStr = QryStr + " Left Join"
QryStr = QryStr + " CUSTOMER C On"
QryStr = QryStr + " Q.CUST_ID = C.CUST_ID"
QryStr = QryStr + " Where"
QryStr = QryStr + " Q.QUOTE_ID = '" + QuoteID + "'"
'*** 30/09/2020 DRN - Material Filter
QryStr = QryStr + "And M.MATERIAL_CODE <> 'TIMBER'"
'10/02/2017 SMK added in this line as all item versions were being returned
QryStr = QryStr + " And Quote_Vers_Stop = (Select Max(Quote_Vers_Stop) From Quote_Item Where Quote_ID = '" + QuoteID + "')"
If DlgValue("OptimisationOption") = 1 Then
QryStr = QryStr + " and QI.QTE_POS In " + SelectedStatusQuoteItems
QryStr = QryStr + " and QI.ITEM_STATUS_ID = " + Str(iStatusID)
End If
'Clipboard QryStr
Pieces = GetQuery(QryStr)
If IsNull(Pieces) Then
MsgBox("There is no BOM saved for Quote.", vbCritical, "Exit Macro")
Exit All
End If
End Sub
Function ClearBars(sCutPlan)
QryStr = " delete from bom_bar_cut "
QryStr = QryStr + " where bom_cutplan_piece_id In (Select bom_cutplan_piece_id from bom_cutplan_piece "
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = 9 Or cutplan_type = 2))"
QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = " + sCutPlan + "))"
DoQuery(QryStr)
QryStr = " delete from bom_cutplan_piece "
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = 9 Or cutplan_type = 2)"
QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = " + sCutPlan + ")"
DoQuery(QryStr)
QryStr = " delete from bom_bar "
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = 9 Or cutplan_type = 2) "
QryStr = QryStr + " where bom_cutplan_id In (Select bom_cutplan_id from bom_cutplan where cutplan_type = " + sCutPlan + ") "
DoQuery(QryStr)
'*** 07/03/2019 DRN - Use Custom CutPlan so not interferring with normal CutPlans (ie 2 and 9)
'QryStr = " delete from bom_cutplan where cutplan_type = 9 Or cutplan_type = 2 "
QryStr = " delete from bom_cutplan where cutplan_type = " + sCutPlan + " "
DoQuery(QryStr)
End Function
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, "C:\Users\username\documents\")
'BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'BrowseForFolder("C:\Users\username\documents\")
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to previous selection
BrowseForFolder = sCNCFilePath
End Function
Private Function ExportNCX
Set oXMLStruct = New TextFile
CheckSubFolderNCX
oXMLStruct.FileName = sCNCFilePath + "\NCX\Quote_" + QuotePref + "-" + QuoteNum + "-" + QuoteSuf + "_" + CStr(Day(Now)) + " " + CStr(Month(Now)) + ".ncx"
oXMLStruct.Clear
oXMLStruct.Open
oXMLStruct.Append(":JOB")
oXMLStruct.Append("")
oXMLStruct.Append("JIdentNo" + vbTab + vbTab + "= " + QuotePref + "-" + QuoteNum + "-" + QuoteSuf)
oXMLStruct.Append("info" + vbTab + vbTab + vbTab + "= " + QuoteTitle)
oXMLStruct.Append("JNo" + vbTab + vbTab + vbTab + vbTab + "= " )
GetNCXBarDetails
End Function
Function GetNCXBarDetails
Dim Qry As Query
Set qry = ObjectFactory.CreateQuery
QryStr = "Select Distinct"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " FINCOL_CODE,"
QryStr = QryStr + " BAR_LENGTH,"
QryStr = QryStr + " EXTN_HEIGHT,"
QryStr = QryStr + " EXTN_WIDTH,"
QryStr = QryStr + " NEW_BAR_QTY, "
QryStr = QryStr + " BOM_BAR_ID, "
QryStr = QryStr + " EXTN_LIB_ID, "
QryStr = QryStr + " EXTN_ID"
QryStr = QryStr + " From UDT_QTE_MAT_QTY"
QryStr = QryStr + " where NEW_BAR_QTY Is Not Null"
QryStr = QryStr + " Order By"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " FINCOL_CODE"
'Clipboard QryStr
qry.SQL = QryStr
qry.Open
Dim BNo As Integer
BNo = 0
While Not qry.Eof
oXMLStruct.Append("")
oXMLStruct.Append(":BAR")
oXMLStruct.Append("")
oXMLStruct.Append("BNo" + vbTab + vbTab + vbTab + vbTab + "= " + CStr(BNo))
oXMLStruct.Append("BIdentNo" + vbTab + vbTab + "= " + qry.Fields("EXTN_CODE"))
oXMLStruct.Append("BSurface" + vbTab + vbTab + "= " + qry.Fields("FINCOL_CODE"))
oXMLStruct.Append("BMaterial" + vbTab + vbTab + "= " + GetMaterial(qry.Fields("EXTN_LIB_ID"),qry.Fields("EXTN_ID")))
If Not IsNull(qry.Fields("NEW_BAR_QTY")) Then
oXMLStruct.Append("BCount" + vbTab + vbTab + vbTab + "= " + qry.Fields("NEW_BAR_QTY"))
End If
oXMLStruct.Append("BLength" + vbTab + vbTab + vbTab + "= " + qry.Fields("BAR_LENGTH"))
oXMLStruct.Append("BWidth" + vbTab + vbTab + vbTab + "= " + qry.Fields("EXTN_WIDTH"))
oXMLStruct.Append("BHeight" + vbTab + vbTab + vbTab + "= " + qry.Fields("EXTN_HEIGHT"))
oXMLStruct.Append("BFileDB" + vbTab + vbTab + vbTab + "= " + qry.Fields("EXTN_CODE") + ".epd")
GetNCXCutDetails(qry.Fields("BOM_BAR_ID"))
BNo = BNo + 1
qry.Next
Wend
End Function
Private Function GetMaterial(Extn_Lib_Id As Integer,Extn_Id As Integer) As String
Dim extn As Extrusion
Set extn = ObjectFactory.CreateExtrusion
If extn.LoadFromID(Extn_Lib_Id,Extn_Id) Then
Return codeof(extn.MaterialRef)
End If
End Function
Function GetNCXCutDetails(BomBarID)
Dim Qry As Query
Set qry = ObjectFactory.CreateQuery
QryStr = "Select"
QryStr = QryStr + " PIECE_COUNT,"
QryStr = QryStr + " EXTN_CODE,"
QryStr = QryStr + " CUT_1A,"
QryStr = QryStr + " CUT_2A,"
QryStr = QryStr + " CUT_1B,"
QryStr = QryStr + " CUT_2B,"
QryStr = QryStr + " PIECE_LENGTH,"
QryStr = QryStr + " EXTN_HEIGHT,"
QryStr = QryStr + " EXTN_WIDTH,"
QryStr = QryStr + " EXTN_DESCR,"
QryStr = QryStr + " BOM_PIECE_ID"
QryStr = QryStr + " From"
QryStr = QryStr + " UDT_QTE_MAT_QTY"
QryStr = QryStr + " Where BOM_BAR_ID = :BomBarID"
qry.SQL = QryStr
qry.Params("@BomBarID") = BomBarID
qry.Open
Dim CNo As Integer
CNo = 0
While Not qry.Eof
Dim QryRemark As Query
Dim Remark As String
Dim LeftCut As String
Dim RightCut As String
Dim AngleLH As String
Dim AngleLV As String
Dim AngleRH As String
Dim AngleRV As String
Set QryRemark = ObjectFactory.CreateQuery
QryRemark.SQL = "select REMARK, CUT_SPEC1, CUT_SPEC2 from BOM_PIECE WHERE BOM_PIECE_ID = :PieceID"
QryRemark.Params("@PieceID") = qry.Fields("BOM_PIECE_ID")
QryRemark.Open
QryRemark.First
If Not IsNull(QryRemark.Fields("REMARK")) Then
Remark = QryRemark.Fields("REMARK")
End If
If Not IsNull(QryRemark.Fields("CUT_SPEC1")) Then
LeftCut = QryRemark.Fields("CUT_SPEC1")
End If
If Not IsNull(QryRemark.Fields("CUT_SPEC2")) Then
RightCut = QryRemark.Fields("CUT_SPEC2")
End If
If LeftCut <> "" Then
If Split(LeftCut,",")(0) = 0 Then 'Left Cut from Top
AngleLH = Split(LeftCut,",")(1)
AngleLV = Split(LeftCut,",")(2)
Else 'Left Cut from Front
AngleLH = Split(LeftCut,",")(2)
AngleLV = Split(LeftCut,",")(1)
End If
End If
If RightCut <> "" Then
If Split(RightCut,",")(0) = 0 Then 'Right Cut from Top
AngleRH = Split(RightCut,",")(1)
AngleRV = Split(RightCut,",")(2)
Else 'Right Cut from Front
AngleRH = Split(RightCut,",")(2)
AngleRV = Split(RightCut,",")(1)
End If
End If
'Set Angle 0 to 90
If AngleLH = "0.0" Then
AngleLH = "90.0"
End If
If AngleLV = "0.0" Then
AngleLV = "90.0"
End If
If AngleRH = "0.0" Then
AngleRH = "90.0"
End If
If AngleRV = "0.0" Then
AngleRV = "90.0"
End If
oXMLStruct.Append("")
oXMLStruct.Append(":CUT")
oXMLStruct.Append("")
oXMLStruct.Append("CNo" + vbTab + vbTab + vbTab + vbTab + "= " + CStr(CNo))
oXMLStruct.Append("CCount" + vbTab + vbTab + vbTab + "= " + qry.Fields("PIECE_COUNT"))
oXMLStruct.Append("CDescription" + vbTab + "= " + qry.Fields("EXTN_DESCR"))
oXMLStruct.Append("CComment" + vbTab + vbTab + "= " + Remark)
oXMLStruct.Append("CComNo" + vbTab + vbTab + vbTab + "= " + qry.Fields("BOM_PIECE_ID"))
oXMLStruct.Append("CPartNo" + vbTab + vbTab + vbTab + "= " + qry.Fields("EXTN_CODE"))
oXMLStruct.Append("CRotation" + vbTab + vbTab + "= 0")
oXMLStruct.Append("CAngleLH" + vbTab + vbTab + "= " + AngleLH)
oXMLStruct.Append("CAngleRH" + vbTab + vbTab + "= " + AngleRH)
oXMLStruct.Append("CAngleLV" + vbTab + vbTab + "= " + AngleLV)
oXMLStruct.Append("CAngleRV" + vbTab + vbTab + "= " + AngleRV)
oXMLStruct.Append("CLength" + vbTab + vbTab + vbTab + "= " + qry.Fields("PIECE_LENGTH"))
oXMLStruct.Append("CStation" + vbTab + vbTab + "= 1")
CNo = CNo + 1
qry.Next
Wend
End Function