随手杂记

'定义 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时，就不再生成新的单据。