|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?注册账号
×
Dim iRow As Long
Dim mInv As ClsInventory
Dim Rs As ADODB.Recordset, sSql As String, sMsg As String
Dim ParentID, ComponentId As Long
Dim Recs As Long
Dim mWh As ClsWareHouse
bEnd = False
If MsgBox("是否展开到末级!", vbYesNo) = vbNo Then
bEnd = False
Else
bEnd = True
End If
sTempTbl = "ZTemp_" & ComputerName
sSql = "if exists (select * from dbo.sysobjects where Name = '" & sTempTbl & "')" & _
" drop table " & sTempTbl
sSql = sSql + " CREATE TABLE " & sTempTbl & "( " & _
"[AutoID] [int] IDENTITY (1, 1) NOT NULL ," & _
"[cInvCode] [varchar] (50) NOT NULL ," & _
"[iNum] float Not NULL, " & _
"[cWhCode] [varchar] (50) , " & _
") ON [PRIMARY]"
If Not gDBO.ExecuteSQL(sSql, Recs, sMsg) Then
If Len(sMsg) <> 0 Then
MsgBox sMsg
Exit Sub
End If
End If
ParentID = BomGetPartID(txtcInvCode.ToolTipText)
sSql = "select * from bom_bom inner join bom_parent on bom_bom.bomid=bom_parent.bomid where "
sSql = sSql & "parentid=" & ParentID
If NBlank(txtIdentCode.Text) <> "" Then
sSql = sSql & " and isnull(IdentCode,'')='" & NBlank(txtIdentCode.Text) & "'"
End If
If Not gDBO.GetRecordset(Rs, sSql, sMsg) Then
MsgBox sMsg
Exit Sub
End If
If Rs.RecordCount = 0 Then
sSql = "insert into " & sTempTbl & " (cInvCode,iNum) values ('" & txtcInvCode.ToolTipText & "',1) "
If Not gDBO.ExecuteSQL(sSql, Recs, sMsg) Then
If Len(sMsg) <> 0 Then
MsgBox sMsg
Exit Sub
End If
End If
Else
Call SetBomGrid(Rs!BomId, 1)
End If
sSql = "select cInvCode,cWhCode,Sum(iNum) as iSum from " & sTempTbl & " group by cinvcode,cWhCode"
If Not gDBO.GetRecordset(Rs, sSql, sMsg) Then
MsgBox sMsg
Exit Sub
End If
If Rs Is Nothing Then Exit Sub
InitGrid
grid.Rows = Rs.RecordCount + 1
For iRow = 1 To Rs.RecordCount
grid.TextMatrix(iRow, 0) = iRow
grid.TextMatrix(iRow, 1) = Rs!cInvCode
Set mInv = New ClsInventory
mInv.GetDetail Rs!cInvCode
grid.TextMatrix(iRow, 2) = NBlank(mInv.cInvName)
grid.TextMatrix(iRow, 3) = NBlank(mInv.cInvStd)
grid.TextMatrix(iRow, 4) = NBlank(mInv.cInvAddCode)
grid.TextMatrix(iRow, 5) = GetComUnitName(mInv.cComunitCode)
grid.TextMatrix(iRow, 6) = Nz(Rs!iSum)
Set mWh = New ClsWareHouse
mWh.GetDetail NBlank(Rs!cWhCode)
grid.TextMatrix(iRow, 9) = NBlank(mWh.cWhName)
Rs.MoveNext
Next iRow
End Sub
Private Sub SetBomGrid(BomId As Long, iNum As Long)
Dim Rs As ADODB.Recordset, sSql As String, sMsg As String
Dim Rs_2 As ADODB.Recordset
Dim ParentID, ComponentId As Long
Dim mInv As ClsInventory
Dim iRow As Long
Dim Recs As Long
sSql = "select * from bom_opcomponent INNER JOIN bas_part ON bas_part.partID=bom_opcomponent.componentid inner join "
sSql = sSql & " Inventory ON Inventory.cInvCode=bas_part.InvCode Left JOIN bom_opcomponentopt ON "
sSql = sSql & " bom_opcomponent.OptionsId=bom_opcomponentopt.OptionsId Where bService<>1 and "
sSql = sSql & " Bomid=" & BomId & " order by componentid "
If Not gDBO.GetRecordset(Rs, sSql, sMsg) Then
MsgBox sMsg
Exit Sub
End If
If Rs.RecordCount = 0 Then
MsgBox "该产品物料清单不全!"
Exit Sub
End If
For iRow = 1 To Rs.RecordCount
sSql = "select * from bom_bom inner join bom_parent on bom_bom.bomid=bom_parent.bomid where "
sSql = sSql & "parentid=" & Rs!ComponentId
If Not gDBO.GetRecordset(Rs_2, sSql, sMsg) Then
MsgBox sMsg
Exit Sub
End If
If Rs_2 Is Nothing Then
MsgBox "该产品物料清单不全!"
Exit Sub
End If
If Rs_2.RecordCount > 0 And bEnd = True Then
SetBomGrid Rs_2!BomId, Round(Nz(Rs!BaseQtyN) / Nz(Rs!BaseQtyD) * (100 + Nz(Rs!CompScrap)) / 100, 2) * iNum
Else
sSql = "insert into " & sTempTbl & " (cInvCode,iNum,cWhCode) values ('" & BomGetInvCode(Rs!ComponentId) & "'," & Round(Nz(Rs!BaseQtyN) / Nz(Rs!BaseQtyD) * (100 + Nz(Rs!CompScrap)) / 100, 2) * iNum & ",'" & NBlank(Rs!WhCode) & "')"
If Not gDBO.ExecuteSQL(sSql, Recs, sMsg) Then
If Len(sMsg) <> 0 Then
MsgBox sMsg
Exit Sub
End If
End If
End If
Rs.MoveNext
Next iRow
End Sub
Public Function BomGetPartID(cInvCode As String) As String
Dim Rs As New ADODB.Recordset, sSql As String, sMsg As String
sSql = "select PartID from bas_part where InvCode='" & cInvCode & "'"
If Not gDBO.GetRecordset(Rs, sSql, sMsg) Then
MsgBox sMsg
Exit Function
End If
If Rs.RecordCount > 0 Then
BomGetPartID = Rs!PartId
End If
Set Rs = Nothing
End Function
Public Function BomGetInvCode(PartId As Double) As String
Dim Rs As New ADODB.Recordset, sSql As String, sMsg As String
sSql = "select InvCode from bas_part where partid=" & PartId
If Not gDBO.GetRecordset(Rs, sSql, sMsg) Then
MsgBox sMsg
Exit Function
End If
If Rs.RecordCount > 0 Then
BomGetInvCode = Rs!InvCode
End If
Set Rs = Nothing
End Function |
|