oaminmodu.bas

一个OA办公自动化管理系统

    Exit Function
Err_DataTranns:
    DataTranns = 1
    'MisMsg "DataTranns Error : " & Err.Description
    Exit Function
    
End Function
Public Function SelectMid(MidString As String, BeginInt As Integer) As String
    Dim i As Integer
    SelectMid = ""
    For i = BeginInt To Len(MidString)
         If Mid(MidString, i, 1) = "|" Then
            Exit For
         End If
         SelectMid = SelectMid & Mid(MidString, i, 1)
    Next
End Function


Public Function strMid(strMidString As String, intMid As Integer) As String
    strMid = ""
    On Error GoTo Err_strMid
    Dim i As Integer, IntCount As Integer
    IntCount = 0
    If strMidString = "" Then Exit Function
    For i = 1 To Len(strMidString)
        If intMid = 1 Then
            strMid = SelectMid(strMidString, 1)
        Else
            If Mid(strMidString, i, 1) = "|" Then
                IntCount = IntCount + 1
                If IntCount = intMid - 1 Then
                    strMid = SelectMid(strMidString, i + 1)
                    Exit For
                End If
            End If
        End If
    Next
    Exit Function
Err_strMid:
    strMid = ""
    MisMsg "strMid Error : " & strMid
    Exit Function
End Function

Public Function WriteFlowSub(strFuncID As String, strBillNo As String) As Integer
WriteFlowSub = 0
'On Error GoTo Err_WriteFlowSub
    Dim rstFlow As Recordset, rstCheckFlow As Recordset
    Set rstCheckFlow = New Recordset
    GetCNClient.Execute "Delete  From PubCheckFlow where BillNo='" & strBillNo & "'"
    
    Set rstFlow = New Recordset
    rstFlow.Open "Select * From PubOAFlow Where FlowID='" & DLookUp("FlowID", "PubFlowMain", "BeginFuncID='" & strFuncID & "'") & "' ", GetCNClient, adOpenForwardOnly
    Do Until rstFlow.EOF
        
        Set rstCheckFlow = New Recordset
        rstCheckFlow.Open "Select * From PubCheckFlow Where BillNO='" & strBillNo & "' And GroupID='" & rstFlow![GroupID] & "' and TeamID='" & rstFlow![Teamid] & "' And PowerID='" & rstFlow![FuncPower] & "' ", GetCNClient, adOpenStatic, adLockReadOnly
        If rstCheckFlow.RecordCount = 0 Then
            GetCNClient.Execute "Insert Into PubCheckFlow(FlowID,GroupID,TeamID,PowerID,FuncID,BillNO,Idea) Values('" & rstFlow![FlowID] & "','" & rstFlow![GroupID] & "','" & rstFlow![Teamid] & "','" & rstFlow![FuncPower] & "','" & rstFlow![FuncID] & "','" & strBillNo & "',0  )"
        End If
        
        Set rstCheckFlow = New Recordset
        rstCheckFlow.Open "Select * From PubCheckFlow Where BillNO='" & strBillNo & "' And GroupID='" & rstFlow![NextGroupID] & "' and TeamID='" & rstFlow![NextTeamID] & "' And PowerID='" & rstFlow![NextFuncPower] & "' ", GetCNClient, adOpenStatic, adLockReadOnly
        If rstCheckFlow.RecordCount = 0 Then
            GetCNClient.Execute "Insert Into PubCheckFlow(FlowID,GroupID,TeamID,PowerID,FuncID,BillNO,Idea) Values('" & rstFlow![FlowID] & "','" & rstFlow![NextGroupID] & "','" & rstFlow![NextTeamID] & "','" & rstFlow![NextFuncPower] & "','" & rstFlow![NextFuncID] & "','" & strBillNo & "',0  )"
        End If
        rstFlow.MoveNext
    Loop
    
    GetCNClient.Execute "Delete  From PubCheckFlow where GroupID='*' and TeamID='*'"
    WriteFlowSub = 1
Exit Function
Err_WriteFlowSub:
    WriteFlowSub = 0
    MisMsg "WriteFlowSub Error " & Err.Description
Exit Function
End Function


Public Function WriteFlow(strFuncID As String, strBillNo As String) As Integer
WriteFlow = 0
'On Error GoTo Err_WriteFlow
    Dim rstIsOA As Recordset
    Set rstIsOA = New Recordset
    rstIsOA.Open "Select IsOA From AccountName Where AccountId='" & strAccountName & "'", GetCNMain, adOpenForwardOnly
    If rstIsOA.EOF Then Exit Function
    If rstIsOA![IsOA] = 0 Then
        WriteFlow = 1
    Else
        Set rstIsOA = New Recordset
        rstIsOA.Open "Select * From PubFlowMain Where BeginFuncID='" & strFuncID & "' ", GetCNClient, adOpenForwardOnly
        If rstIsOA.EOF Then
            WriteFlow = 2
        Else
           If WriteFlowSub(strFuncID, strBillNo) = 0 Then
                WriteFlow = 3
           Else
                WriteFlow = 4
           End If
        End If
    End If
    Exit Function
Err_WriteFlow:
    WriteFlow = 4
    MisMsg "WriteFlow Error:" & Err.Description
    Exit Function
End Function

Public Function IsFlow(ByVal strFuncID As String, Optional ByVal strBillNo As String) As Integer
On Error GoTo Err_IsFlow
    Dim rstIsOA As Recordset
    IsFlow = 0     '无此帐套
    Set rstIsOA = New Recordset
    rstIsOA.Open "Select IsOA From AccountName Where AccountId='" & strAccountName & "'", GetCNMain, adOpenForwardOnly
    If rstIsOA.EOF Then Exit Function
    If rstIsOA![IsOA] = 0 Then
        IsFlow = 1   '不使用流程
    Else
        Set rstIsOA = New Recordset
        rstIsOA.Open "Select * From v_UserCheckFlow Where FuncID='" & strFuncID & "' and PowerID='4' ", GetCNClient, adOpenForwardOnly
        If rstIsOA.EOF Then
            IsFlow = 2  '使用流程但无需审核
        Else
            IsFlow = 3  '使用流程且需审核
        End If
    End If
    Exit Function
Err_IsFlow:
    IsFlow = 4
    MisMsg "IsFlow Error:" & Err.Description
    Exit Function
End Function

Public Function ShowFlowCheck(BillNO As String)
    FLowBillNo = BillNO
    frmCheckFlow.Show 1
End Function

Public Function SelectSize() As String
Dim i As Integer
 'SelectSize = "Size1"
 For i = 1 To 30
    SelectSize = SelectSize & ",Size" & i
 Next
End Function

Public Function SelectSizeSumP() As String
Dim i As Integer
 'SelectSize = "Size1"
 For i = 1 To 30
    SelectSizeSumP = SelectSizeSumP & ",Sum(Size" & i & " * Piece)  as Size" & i
 Next
End Function

Public Function SelectSizeSum() As String
Dim i As Integer
 'SelectSize = "Size1"
 For i = 1 To 30
    SelectSizeSum = SelectSizeSum & ",Sum(Size" & i & ")  as Size" & i
 Next
End Function

Public Function TransData(BillNO As String) As Integer
    TransData = 0
'On Error GoTo Err_TransData
    Dim RstSource As Recordset, rstDest As Recordset, i As Integer
    Dim RstSourceDetail As Recordset, rstDestDetail As Recordset
    
    '表头
    
    Set RstSource = New Recordset
    Set rstDest = New Recordset
    Set RstSourceDetail = New Recordset
    Set rstDestDetail = New Recordset
    RstSource.Open "Select * From Local_Inventory_Evidence Where Evidence_Number='" & BillNO & "'", GetCNLocal, adOpenStatic, adLockBatchOptimistic
    rstDest.Open "Select * From Inventory_Evidence Where Evidence_Number='" & BillNO & "' ", GetCNClient, adOpenStatic, adLockBatchOptimistic
    RstSourceDetail.Open "Select * From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'", GetCNLocal, adOpenStatic, adLockReadOnly
    rstDestDetail.Open "Select * From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "' ", GetCNClient, adOpenStatic, adLockBatchOptimistic
    
    If RstSourceDetail.RecordCount = 0 Then Exit Function
   
    If rstDest.RecordCount > 0 Then
        MisMsg "此单据已存在！"
        Exit Function
    End If
    
    
    GetCNClient.BeginTrans
    rstDest.AddNew
    For i = 0 To RstSource.Fields.Count - 1
        If RstSource.Fields(i).name <> "ID" Then
            rstDest.Fields(RstSource.Fields(i).name).Value = Nz(RstSource.Fields(i).Value, 0)
        End If
    Next
    
    rstDest.UpdateBatch
    
    '明细
    
    
    If rstDestDetail.RecordCount > 0 Then
        GetCNClient.Execute "Delete From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
    End If
    
    RstSourceDetail.MoveFirst
    Do Until RstSourceDetail.EOF
        rstDestDetail.AddNew
        For i = 0 To RstSourceDetail.Fields.Count - 1
            If RstSourceDetail.Fields(i).name <> "ID" Then
                rstDestDetail.Fields(RstSourceDetail.Fields(i).name) = Nz(RstSourceDetail.Fields(i).Value, "")
            End If
        Next
       RstSourceDetail.MoveNext
    Loop
    
    rstDestDetail.UpdateBatch
    
    GetCNLocal.Execute "Delete From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
    GetCNLocal.Execute "Delete From Local_Inventory_Evidence Where Evidence_Number='" & BillNO & "'"
    
    TransData = 1
    GetCNClient.CommitTrans
    
    Set RstSource = Nothing
    Set rstDest = Nothing
    Set RstSourceDetail = Nothing
    Set rstDestDetail = Nothing

    
    Exit Function

Err_TransData:
    TransData = 0
    
    GetCNClient.RollbackTrans
    
    Exit Function
End Function


Public Function unTransData(BillNO As String) As Integer
    unTransData = 0
'On Error GoTo Err_unTransData
    Dim RstSource As Recordset, rstDest As Recordset, i As Integer
    Dim RstSourceDetail As Recordset, rstDestDetail As Recordset
    
    
    Set RstSource = New Recordset
    Set rstDest = New Recordset
    Set RstSourceDetail = New Recordset
    Set rstDestDetail = New Recordset
    RstSource.Open "Select * From Inventory_Evidence Where Evidence_Number='" & BillNO & "'", GetCNClient, adOpenStatic, adLockBatchOptimistic
    rstDest.Open "Select * From Local_Inventory_Evidence Where Evidence_Number='" & BillNO & "' ", GetCNLocal, adOpenStatic, adLockBatchOptimistic
    RstSourceDetail.Open "Select * From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'", GetCNClient, adOpenStatic, adLockReadOnly
    rstDestDetail.Open "Select * From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "' ", GetCNLocal, adOpenStatic, adLockBatchOptimistic
     
     '表头
   
    If RstSourceDetail.RecordCount = 0 Then Exit Function
   
    If rstDest.RecordCount > 0 Then
        MisMsg "此单据已存在！"
        Exit Function
    End If
    
    
    GetCNLocal.BeginTrans
    rstDest.AddNew
    For i = 0 To rstDest.Fields.Count - 1
        If rstDest.Fields(i).name <> "ID" Then
            rstDest.Fields(i).Value = Nz(RstSource.Fields(rstDest.Fields(i).name).Value, 0)
        End If
    Next
    
    rstDest.UpdateBatch
    
    '明细
    
    
    If rstDestDetail.RecordCount > 0 Then
        GetCNLocal.Execute "Delete From Local_Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
    End If
    
    RstSourceDetail.MoveFirst
    Do Until RstSourceDetail.EOF
        rstDestDetail.AddNew
        For i = 0 To rstDestDetail.Fields.Count - 1
            If rstDestDetail.Fields(i).name <> "ID" Then
                rstDestDetail.Fields(i) = Nz(RstSourceDetail.Fields(rstDestDetail.Fields(i).name).Value, "")
            End If
        Next
       RstSourceDetail.MoveNext
    Loop
    
    rstDestDetail.UpdateBatch
    
    GetCNClient.Execute "Delete From Inventory_Evidence_Detail Where Evidence_Number='" & BillNO & "'"
    GetCNClient.Execute "Delete From Inventory_Evidence Where Evidence_Number='" & BillNO & "'"
    
    unTransData = 1
    GetCNLocal.CommitTrans
    
    Set RstSource = Nothing
    Set rstDest = Nothing
    Set RstSourceDetail = Nothing
    Set rstDestDetail = Nothing

    Exit Function

Err_unTransData:
    unTransData = 0
    
    GetCNLocal.RollbackTrans