跪求：金碟k3BOS二次开发请教（让大家费神了）

hz03zhuhaowen 2008-07-11 07:25:29

'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface As BillEvent

Public Sub Show(ByVal oBillInterface As Object)

'BillEvent 接口实现
'注意: 此方法必须存在, 请勿修改
Set m_BillInterface = oBillInterface

End Sub

Private Sub Class_Terminate()

'释放接口对象
'注意: 此方法必须存在, 请勿修改
Set m_BillInterface = Nothing

End Sub

Private Sub m_BillInterface_FinishMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, bSendMessage As Boolean)

'TODO: 请在此处添加代码响应事件 FinishMultiCheck
Dim obj As BOSField
Dim obj1 As BOSField
Dim obj2 As BOSField
Dim obj3 As BOSField
Dim obj4 As BOSField
Dim obj5 As BOSField
Dim obj6 As BOSField
''''''''''''''''''''''
Dim obj7 As BOSField
Dim obj8 As BOSField
Dim obj9 As BOSField
Dim obj10 As BOSField
Dim obj11 As BOSField
Dim obj12 As BOSField
Dim obj13 As BOSField
Dim obj14 As BOSField '''
Dim obj15 As BOSField

Dim wuliaodaima() As Long

Dim jiliangdanwei() As Long

Dim shishoushuliang() As Double

Dim danjia() As Variant
Dim jine() As Variant
Dim beizhu1 As Variant

Dim canku() As Long

Dim gongyingshang As Variant

Dim fukuanriqi As Date

Dim riqi As Date

Dim danjubianhao As Variant

Dim baoguan As Long

Dim yanshou As Long

Dim zhidanren As Long
Dim caigoufangshi As Integer '''

Dim i As Long
Dim maxrow As Long
Dim FInterID As Long
Dim FBillNo As Variant

Dim FInterIDQT As Long
Dim FBillNoQT As Variant

Dim FBillNoXC As Variant
Dim FInterIDXC As Variant

Dim conn As String
Dim strsql As String

Dim strsql1 As String
Dim strsql2 As String

Dim strsql3 As String
Dim strsql4 As String

Dim strsql5 As String
Dim strsql6 As String

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim rs2 As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset

Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset

Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset

Dim fid As Integer

fid = m_BillInterface.Data("fid")

Set obj = m_BillInterface.BillEntrys(1).BOSFields("FMaterialCode") '取物料代码
maxrow = m_BillInterface.Data("Page2").UBound '获得当前单据体分录行数
ReDim wuliaodaima(maxrow) As Long
For i = 1 To maxrow
obj.Row = i
wuliaodaima(i - 1) = obj.Value

Next

Set obj1 = m_BillInterface.BillEntrys(1).BOSFields("FUnit") '取计量单位
maxrow = m_BillInterface.Data("Page2").UBound
ReDim jiliangdanwei(maxrow) As Long
For i = 1 To maxrow
obj1.Row = i
jiliangdanwei(i - 1) = obj1.Value

Next

Set obj6 = m_BillInterface.BillEntrys(1).BOSFields("FWarehouse") '取仓库
maxrow = m_BillInterface.Data("Page2").UBound
ReDim canku(maxrow) As Long
For i = 1 To maxrow
obj6.Row = i
canku(i - 1) = obj6.Value

Next

Set obj7 = m_BillInterface.BillHeads(1).BOSFields("FVendor") '供应商
gongyingshang = obj7.Value

Set obj8 = m_BillInterface.BillHeads(1).BOSFields("FPDate") '付款日期
fukuanriqi = obj8.Value

Set obj9 = m_BillInterface.BillHeads(1).BOSFields("FDate") '日期
riqi = obj9.Value

Set obj10 = m_BillInterface.BillHeads(1).BOSFields("FBillNo") '单据编号
danjubianhao = obj10.Value
' MsgBox (danjubianhao)

Set obj13 = m_BillInterface.BillHeads(1).BOSFields("FBiller") '制单人
zhidanren = obj13.Value
' MsgBox (zhidanren)

conn = "Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=AIS20080516145204;Data Source=JINDEEE"
With cn
.ConnectionString = conn
.Open

' 取（外购入库单）当前单据编号

strsql1 = "select left(convert(varchar(12),getdate(),12),4) as a"
strsql2 = "select * from Icbillno where fbillid=1"
Set rs1 = .Execute(strsql1)
Set rs2 = .Execute(strsql2)
If Not (rs1.EOF And rs2.EOF) Then

FBillNo = rs2("FPreLetter") & rs1("a") & Format(rs2("FCurNo"), Right(rs2("FFormat"), 4))
End If

'Set rs = Nothing
'取外购入库单据内码FInterID
strsql = "select FMaxNum from ICMaxNum where ftablename='ICStockBill'"

Set rs = cn.Execute(strsql)

If Not rs.EOF Then
FInterID = rs("FMaxNum") + 1

End If

Set rs = Nothing
'把文具入库单的数据插入给外购入库单
.Execute "delete from ICStockbillEntry where FInterID=" & FInterID
For i = 1 To maxrow

strsql = "insert into ICStockbillEntry(FInterID,FEntryID,FBrNo,FItemID,FUnitID,FAuxQty,FauxPrice,Famount,FDCStockID,FSourceInterID,FSourceBillNo,FSourceTranType,FSourceEntryID)" & _
" values(" & FInterID & "," & i & "," & 0 & "," & wuliaodaima(i - 1) & "," & jiliangdanwei(i - 1) & "," & shishoushuliang(i - 1) & "," & danjia(i - 1) & "," & jine(i - 1) & "," & canku(i - 1) & "," & fid & ",'" & danjubianhao & "'," & 200000011 & "," & i & " )"
.Execute (strsql)

Next

i = i + 1
If i > 1 Then

strsql = "insert into ICStockBill(FInterID,FBillNo,FBrNo,FTranType,Fdate,FBillerID,FFManagerID,FSManagerID,FSupplyID,FSettleDate,FPOStyle)" & _
"values('" & FInterID & "','" & FBillNo & "','" & 0 & "','" & 1 & "','" & riqi & _
"'," & zhidanren & "," & yanshou & "," & baoguan & "," & gongyingshang & ",'" & fukuanriqi & "','" & caigoufangshi & "')"

.Execute (strsql)
End If

' 更新单据流水号
strsql = "update icbillno set FCurno=FCurno+1"
.Execute (strsql)
' 更新单据最大内码
strsql = "update icmaxnum set FMaxNum=FMaxNum+1"

.Execute (strsql)

If i > 1 Then
MsgBox " 成功生成外购入库单 " & FBillNo , vbInformation, " 金蝶提醒 "

End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

strsql = "update t_BOSWJRK set FCreateBillIsOrNo = 1 where FBillNo='" & danjubianhao & "'"
.Execute (strsql)

End With

End Sub

以上程序是录入BOS单据“文具入库单”后，触发事件审核后，会同时生成工业单据“外购入库单”“虚仓入库单”，但是我反审核“文具入库单”，再审核时，还会生成新的单据，为了避免其再生成新的单据，我准备在“文具入库单”上添加一个字段'FCreateBillIsOrNo'，当生成单据时，此字段就更新为1，我就在上面的程序添加一个判断，当FCreateBillIsOrNo为1时，就不再生成新的单据。请问我该怎么写这段代码？

...全文