admin.bas

This a complete inventory management system that performs the functions of Purchases, Sales and paym

Attribute VB_Name = "Admin"
DefInt A-Z
Public CNimanager As ADODB.Connection
Public glbLoginId As String
Public gWareHouseCode As String
Dim fs As FileSystemObject
Dim fil As File
Dim rd As TextStream
Dim rstCheck As ADODB.Recordset
Dim gArr()
Dim gQuery
Public gCRNote As Boolean
Public gConsignerCode As String
Public gDispatchConsigner As String

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Const GWL_STYLE = (-16)

Enum TextInputStyles
 ES_UPPERCASE = &H8&
 ES_LOWERCASE = &H10&
 ES_number = &H2000&
End Enum

Sub Main()
On Error Resume Next

    Set CNimanager = New ADODB.Connection
    With CNimanager
          .ConnectionString = "Provider=Microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\Adequate.mdb"
          .Open
    End With
    
If Not CNimanager.State = 1 Then
    MsgBox "ERROR - Database Not Connected", vbCritical, "iManager"
    Exit Sub
Else
   'frmLogin.Show
   'frmVendorBillNew.Show
   'frmHO2BR.Show
   'frmACMaster.Show
    frmTop.Show
    'frmBranchMaster.Show
   'frmMF2HO.Show
 
    
End If
 

End Sub

Public Function fnEscapeQuote(ByVal pString As String) As String
    Dim gszPosition As Integer
    Dim gszString As String
        gszString = pString
        If Len(gszString) > 0 Then
            gszPosition = 1
        Else
            gszPosition = 0
        End If
        Do While gszPosition > 0
            gszPosition = InStr(gszPosition, gszString, "'")
            If gszPosition > 0 Then
                gszString = Left(gszString, gszPosition) + Mid(gszString, gszPosition)
                gszPosition = gszPosition + 2
            End If
        Loop
        fnEscapeQuote = gszString
    End Function

Public Sub Verify_Login(szUsername As String, szPassword As String)
If Trim(UCase(szUsername)) = "ADMIN" Then
Dim rstLogin As New ADODB.Recordset
Dim strSql As String
    frmLogin.MousePointer = vbHourglass
    strSql = "select * from aCompanySetup where a_sno=1 and a_AdminPassword='" & Trim(szPassword) & "'"
    Set rstLogin = CNimanager.Execute(strSql)
    If rstLogin.EOF Or rstLogin.BOF Then
    MsgBox "Incorrect Password"
    frmLogin.MousePointer = vbNormal
    Exit Sub
    Else
        glbLoginId = Trim(szUsername)
        frmLogin.Timer1.Enabled = True
    End If
    frmLogin.MousePointer = vbNormal
rstLogin.Close
Set rstLogin = Nothing
Else
    MsgBox "Incorrect Login Id"
    frmLogin.txtUserName.SetFocus
    Exit Sub
End If
End Sub

Public Function CheckNullString(ByVal pValue As Variant) As Variant
If IsNull(pValue) Then
    CheckNullString = ""
Else
    CheckNullString = pValue
End If
End Function

Public Sub SetTextInputStyle(hWndTextControl As Long, InputStyle As TextInputStyles)
 Dim Style As Long
 Style = GetWindowLong(hWndTextControl, GWL_STYLE)
 Style = Style Or InputStyle
 SetWindowLong hWndTextControl, GWL_STYLE, Style
End Sub

Public Function chkBlank(ptxtField As Object, pHeader As String) As Boolean
    If Trim(ptxtField) = "" Then
        MsgBox pHeader & " cannot be left blank", vbCritical, "iManager"
        If ptxtField.Enabled = True Then
            ptxtField.SetFocus
        End If
        chkBlank = True
    Else
        chkBlank = False
    End If
End Function

Public Function Null2Blank(pVal As Variant) As Variant
    If IsNull(pVal) = True Then
        Null2Blank = ""
    Else
        Null2Blank = pVal
    End If
End Function

Public Sub gFillCountry(fldCountry As Object, fldState As Object, fldCity As Object)

End Sub

Public Sub gFillState(fldCountry As Object, fldState As Object, fldCity As Object)
End Sub



Public Function Desc2LedgerId(Desc As Variant) As Variant
Dim rstDescId As ADODB.Recordset
Dim gQuery As String
Set rstDescId = New ADODB.Recordset
gQuery = "select LedgerId from aPayment where description='" & Desc & "'"
rstDescId.Open gQuery, CNimanager
If Not rstDescId.EOF Or Not rstDescId.BOF Then
    Desc2LedgerId = Null2Blank(Trim(rstDescId("LedgerId")))
Else
    Desc2LedgerId = ""
End If
End Function

Public Function Desc2DescIdDeduction(Desc As Variant) As Variant
Dim rstDescId As ADODB.Recordset
Dim gQuery As String
Set rstDescId = New ADODB.Recordset
gQuery = "select Sno from aDeduction where description='" & Desc & "'"
rstDescId.Open gQuery, CNimanager
If Not rstDescId.EOF Or Not rstDescId.BOF Then
    Desc2DescIdDeduction = Null2Blank(Trim(rstDescId("Sno")))
Else
    Desc2DescIdDeduction = ""
End If
End Function

Public Function Desc2DescIdAddition(Desc As Variant) As Variant
Dim rstDescId As ADODB.Recordset
Dim gQuery As String
Set rstDescId = New ADODB.Recordset
gQuery = "select Sno from aAddition where description='" & Desc & "'"
rstDescId.Open gQuery, CNimanager
If Not rstDescId.EOF Or Not rstDescId.BOF Then
    Desc2DescIdAddition = Null2Blank(Trim(rstDescId("Sno")))
Else
    Desc2DescIdAddition = ""
End If
End Function
Public Function BRID2BRName(pBRId As Variant) As Variant
Dim rstBRName As ADODB.Recordset
Set rstBRName = New ADODB.Recordset
rstBRName.Open "select * from aBranchMaster where r_Id='" & Trim(pBRId) & "'", CNimanager
If Not rstBRName.EOF Or Not rstBRName.BOF Then
    BRID2BRName = Null2Blank(Trim(rstBRName("r_Name")))
Else
    BRID2BRName = ""
End If
End Function

Public Function BRID2BRPID(pBRId As Variant) As Variant
Dim rstBRPID As ADODB.Recordset
Set rstBRPID = New ADODB.Recordset
rstBRPID.Open "select * from aBranchMaster where r_Id='" & Trim(pBRId) & "'", CNimanager
If Not rstBRPID.EOF Or Not rstBRPID.BOF Then
    BRID2BRPID = Null2Blank(Trim(rstBRPID("r_PromotingId")))
Else
    BRID2BRPID = ""
End If
End Function

Public Function ACID2BankName(pACId As Variant) As Variant
Dim rstAC As ADODB.Recordset
Set rstAC = New ADODB.Recordset
rstAC.Open "select * from aBankAcMaster where b_AcID='" & Trim(pACId) & "'", CNimanager
If Not rstAC.EOF Or Not rstAC.BOF Then
    ACID2BankName = Null2Blank(Trim(rstAC("b_BankName")))
Else
    ACID2BankName = ""
End If
End Function

Public Function PID2PName(vPID As Variant) As Variant

Dim rstPName As ADODB.Recordset
Set rstPName = New ADODB.Recordset
rstPName.Open "select * from aBookMaster where b_ID='" & Trim(vPID) & "'", CNimanager
If Not rstPName.EOF Or Not rstPName.BOF Then
    PID2PName = Null2Blank(Trim(rstPName("b_Name")))
Else
    PID2PName = ""
End If
End Function

Public Function PID2Unit(vPID As Variant) As Variant

Dim rstPName As ADODB.Recordset
Set rstPName = New ADODB.Recordset
rstPName.Open "select * from aBookMaster where b_ID='" & Trim(vPID) & "'", CNimanager
If Not rstPName.EOF Or Not rstPName.BOF Then
    PID2Unit = Null2Blank(Trim(rstPName("b_Unit")))
Else
    PID2Unit = ""
End If
End Function

Public Function BRPID2PREVBal(vBRPID As Variant, vBranchID As Variant, vDate As Date) As Variant
If Not Trim(vBRPID) = "" Then
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    'rst.Open "select * from tBRStock where t_BranchID='" & Trim(vBranchID) & "' and t_ProductID='" & Trim(vBRPID) & "'", CNimanager
    rst.Open "prc_SL_BranchCurrStock '" & Trim(vBranchID) & "','" & Trim(vBRPID) & "','" & vDate & "'", CNimanager
    If Not rst.EOF Or Not rst.BOF Then
        'BRPID2PREVBal = rst("t_Qty")
        BRPID2PREVBal = Val(Null2Blank(rst("CurrBal")))
    Else
        BRPID2PREVBal = Val("0")
    End If
Else
    BRPID2PREVBal = Val("0")
End If
End Function

Public Function BRPID2PrevVal(vBRPID As Variant, vBranchID As Variant) As Variant
If Not Trim(vBRPID) = "" Then
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.Open "select * from tBRStock where t_BranchID='" & Trim(vBranchID) & "' and t_ProductID='" & Trim(vBRPID) & "'", CNimanager
    If Not rst.EOF Or Not rst.BOF Then
        BRPID2PrevVal = Val(Null2Blank(rst("t_value")))
    Else
        BRPID2PrevVal = Val("0")
    End If
Else
    BRPID2PrevVal = Val("0")
End If
End Function

Public Function BRID2BRBal(vBRID As Variant) As Variant
    Dim rst As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.Open "select r_BalanceAmt as Bal from aBranchMaster where r_ID='" & Trim(vBRID) & "'", CNimanager
    If Not rst.EOF Or Not rst.BOF Then
        BRID2BRBal = Null2Blank(rst("Bal"))
    End If
End Function

Public Function NewDebitNote() As Variant
Dim rst As ADODB.Recordset
Dim gNewDebitNote As String
gNewDebitNote = ""
Set rst = New ADODB.Recordset
rst.Open "select a_LastDBNNo from aCompanySetup where a_Sno=1", CNimanager
    If Not rst.EOF Or Not rst.BOF Then
        gNewDebitNote = CStr(Val(Null2Blank(rst("a_LastDBNNo"))) + 1)
    Else
        gNewDebitNote = "1"
    End If
    For i = 1 To 5 - Len(gNewDebitNote)
        gNewDebitNote = "0" & gNewDebitNote
    Next
    gNewDebitNote = "DB" & gNewDebitNote
    NewDebitNote = gNewDebitNote
End Function

Public Function NewCreditNote() As Variant
Dim rst As ADODB.Recordset
Dim gNewCreditNote As String
gNewCreditNote = ""