-

VB开发的ERP系统

    If Not Rectemp.EOF Then
        PGKjYear = Rectemp.Fields("KjYear")
    Else
        Tsxx = "此会计年度不存在!"
        Call Xtxxts(Tsxx, 0, 1)
    End If
   
End Function

Public Function PGNowmon() As Integer              '当前会计月份
    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where chhsjzbz=0 order by kjyear,period")
   
    If Not Rectemp.EOF Then
        PGNowmon = Rectemp.Fields("period")
    Else
        Tsxx = "此会计年度不存在!"
        Call Xtxxts(Tsxx, 0, 1)
    End If
   
End Function

Public Function PGEndDate() As String
    
    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Zzrq from gy_kjrlb where chhsjzbz=0 order by kjyear,period")
   
    If Not Rectemp.EOF Then
        PGEndDate = Rectemp.Fields("Zzrq")
    Else
        Tsxx = "此会计年度不存在!"
        Call Xtxxts(Tsxx, 0, 1)
    End If

End Function

Public Function PGPrevKjYear() As Integer
    
    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Kjyear from gy_kjrlb where chhsjzbz=1 order by kjyear,period")
   
    If Not Rectemp.EOF Then
        Rectemp.MoveLast
        PGPrevKjYear = Rectemp.Fields("Kjyear")
    Else
        Tsxx = "此会计年度不存在!"
        Call Xtxxts(Tsxx, 0, 1)
    End If

End Function

Public Function PGPrevKjMon() As Integer
    
    Dim Rectemp As Recordset
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Period from gy_kjrlb where chhsjzbz=1 order by kjyear,period")
   
    If Not Rectemp.EOF Then
        Rectemp.MoveLast
        PGPrevKjMon = Rectemp.Fields("Period")
    Else
        PGPrevKjMon = 1
    End If

End Function

Public Sub MaccCode(WhCode As String, Mnumber As String, Msort As String)      '设置存货科目、差异科目
                    '仓库编码,存货编码，存货分类
    Dim Rectemp As Recordset
    Dim RecTempFz As Recordset
    Dim Msortcode As String
   
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from chhs_macc where whcode='" & WhCode & "' ")
    If Not Rectemp.EOF Then
        Rectemp.Find "mnumber='" & Mnumber & "'"
        If Not Rectemp.EOF Then
            Xtfhcs = Trim(Rectemp.Fields("macct"))
            Xtfhcsfz = Trim(Rectemp.Fields("diffacct") & "")
            Exit Sub
        Else
            SqlStr = "SELECT * FROM Gy_CodeScheme WHERE (ItemCode = 'Kf_KfwlflSet')"
            Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            If Not RecTempFz.EOF Then
               Msortcode = Left(Trim(RecTempFz.Fields("CodeScheme")), 1)
               Msortcode = Left(Trim(Msort), Val(Msortcode))
            End If
            
            Rectemp.MoveFirst
            Rectemp.Find "msort like '" & Msortcode & "'"
            If Not Rectemp.EOF Then
                Xtfhcs = Trim(Rectemp.Fields("macct"))
                Xtfhcsfz = Trim(Rectemp.Fields("diffacct") & "")
                Exit Sub
            Else
                Rectemp.MoveFirst
                Rectemp.Find "WHCODE = '" & WhCode & "'"
                Xtfhcs = Trim(Rectemp.Fields("macct"))
                Xtfhcsfz = Trim(Rectemp.Fields("diffacct") & "")
                Exit Sub
            End If
        End If
     End If
End Sub

Public Sub DfaccCode(InoutClassCode As String, Deptcode As String, Msort As String, Mnumber As String)     '设置对方科目
                    '收发类别、部门编码,存货分类，存货编码
    Dim Rectemp As Recordset
    Dim RecTempFz As Recordset
    Dim SqlStr As String
    Dim Msortcode As String

    '存货分类顶级编码
    SqlStr = "SELECT * FROM Gy_CodeScheme WHERE (ItemCode = 'Kf_KfwlflSet')"
    Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not RecTempFz.EOF Then
       Msortcode = Left(Trim(RecTempFz.Fields("CodeScheme")), 1)
       Msortcode = Left(Trim(Msort), Val(Msortcode))
    End If
    
    '收发类别+部门+存货
    SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "' " & _
            " and deptcode='" & Deptcode & "' and mnumber='" & Mnumber & "'"
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not Rectemp.EOF Then
        Xtfhcs = Rectemp.Fields("dfacct")
    Else
        If Trim(InoutClassCode) <> "" Then
            If Trim(Deptcode) <> "" Then
                
                '收发类别+部门+存货分类
                SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "' " & _
                        " and deptcode='" & Deptcode & "' and msort like '" & Msortcode & "%' "
                            Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rectemp.EOF Then
                    Xtfhcs = Rectemp.Fields("dfacct")
                Else
                
                     '收发类别+存货分类
                     SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "' " & _
                       " and msort like '" & Msortcode & "%'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not Rectemp.EOF Then
                        Xtfhcs = Rectemp.Fields("dfacct")
                    Else
                         
                         '收发类别
                        SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "'"
                        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                        If Not Rectemp.EOF Then
                            Xtfhcs = Rectemp.Fields("dfacct")
                            Exit Sub
                        End If
                        
                        '部门
                        SqlStr = "select * from chhs_dfacc where deptcode='" & Deptcode & "'"
                        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                        If Not Rectemp.EOF Then
                            Xtfhcs = Rectemp.Fields("dfacct")
                            Exit Sub
                        End If
                        
                        '存货分类
                        SqlStr = "select * from chhs_dfacc where msort like '" & Msortcode & "%'"
                        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                        If Not Rectemp.EOF Then
                            Xtfhcs = Rectemp.Fields("dfacct")
                            Exit Sub
                        End If
                    End If
                End If
            Else
                '收发类别+存货分类
                SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "' " & _
                   " and msort like '" & Msortcode & "%'"
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rectemp.EOF Then
                    Xtfhcs = Rectemp.Fields("dfacct")
                Else
                     '收发类别
                    SqlStr = "select * from chhs_dfacc where inoutclasscode='" & InoutClassCode & "'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not Rectemp.EOF Then
                        Xtfhcs = Rectemp.Fields("dfacct")
                        Exit Sub
                    End If
            
                      '存货分类
                    SqlStr = "select * from chhs_dfacc where msort like '" & Msortcode & "%'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not Rectemp.EOF Then
                        Xtfhcs = Rectemp.Fields("dfacct")
                        Exit Sub
                    End If
              End If
            End If
         Else
            If Trim(Deptcode) <> "" Then
                '部门+存货分类
                SqlStr = "select * from chhs_dfacc where  " & _
                        " deptcode='" & Deptcode & "' and msort like '" & Msortcode & "%' "
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rectemp.EOF Then
                    Xtfhcs = Rectemp.Fields("dfacct")
                Else
                    '部门
                    SqlStr = "select * from chhs_dfacc where deptcode='" & Deptcode & "'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not Rectemp.EOF Then
                        Xtfhcs = Rectemp.Fields("dfacct")
                        Exit Sub
                    End If
                    
                    '存货分类
                    SqlStr = "select * from chhs_dfacc where  msort like '" & Msortcode & "%'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not Rectemp.EOF Then
                        Xtfhcs = Rectemp.Fields("dfacct")
                    End If
                End If
            Else
                '存货分类
                SqlStr = "select * from chhs_dfacc where msort like '" & Msortcode & "%'"
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rectemp.EOF Then
                    Xtfhcs = Rectemp.Fields("dfacct")
                End If
            End If
        End If
    End If
End Sub


Public Function Sub_Records(mDate As Date, mRecrod As String) As Boolean      '单据当天记录集
    Dim RecQuery As Recordset
    Dim SqlStr As String
    
    Sub_Records = True
    SqlStr = "Select InOutMainId from " & mRecrod & " a LEFT OUTER JOIN Gy_Whlimit " & _
            " ON a.WhCode = Gy_Whlimit.WhCode " & _
            " Where  BillDate='" & mDate & "' and Gy_Whlimit.Czybm='" & Xtczybm & "'"
    Set RecQuery = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If RecQuery.EOF Then
        Sub_Records = False
    End If
    
End Function