VB6 MODULE CLASS CONNECTION

CREATE CLASS MODULE NAME : ClsDataAccess
========================================================================
Private objOpenRec As New ADODB.Recordset
Public Function FGetRecords(ByVal strSql As String) As ADODB.Recordset
  
 With objOpenRec
    .ActiveConnection = pathcon
    .CursorType = adOpenKeyset
    .Source = Trim(strSql)
    .LockType = adLockOptimistic
    .Open
End With

Set FGetRecords = objOpenRec
Set objOpenRec = Nothing
Exit Function
End Function

==========================================================================
CREATE MODULE  NAMD : DB_CONNECTION(Any Name)

Option Explicit

Public ObjDataAccess As New ClsDataAccess
Public pathcon As ADODB.Connection
Public COPRS As ADODB.Recordset
Public strSql As String

Public Sub main()
Set pathcon = New ADODB.Connection
'pathcon.Open "PROVIDER=MSDASQL;driver={SQL Server};server=Server;uid=sa;pwd=swtcardio;database=DMS_PAY;"
pathcon.Open "PROVIDER=MSDASQL;driver={SQL Server};server=DEVELOPER;database=suneru;"
Set COPRS = New ADODB.Recordset
Form_EMP_DETAILS.Show
End Sub

=============================================================================
CREATE FORM ANY NAME

Private Sub Text_First_name_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
strSql = ""
    strSql = "SELECT * From Table_1 WHERE (adsd = N'" & Text_First_name & "')"
    If COPRS.State = 1 Then COPRS.Close
    Set COPRS = ObjDataAccess.FGetRecords(strSql)
    If Not COPRS.EOF Then
        While Not COPRS.EOF
        Combo_text.AddItem COPRS!sadd
        COPRS.MoveNext
        Wend
    End If
End If
End Sub
===========================================================================
        CrystalReport2.ReportFileName = App.Path & "/Reports/Rpt_Minimum_NET_SAL_Current.rpt"
        CrystalReport2.WindowState = crptMaximized
        CrystalReport2.Formulas(1) = "YEAR='" & cmbYear1.Text & "'"
        CrystalReport2.Formulas(2) = "MONTH='" & Mid(cmbMonth1.Text, 1, 2) & "'"
        CrystalReport2.Action = 1
        CrystalReport2.PageZoom 100
==========================================================================
      CRYSTAL REPORT OBJECT
CONNECtT : dsn=hrm;uid=sa;pwd=swtcardio

==========================================================================
DSN CREATE
CREATE FUNCTION
=========================================================================
SQLConfigDataSource Call in Create DSN
 
 Private Const ODBC_ADD_DSN = 1        ' Add data source
Private Const ODBC_CONFIG_DSN = 2     ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3     ' Remove data source
Private Const vbAPINull As Long = 0&



'Function Declare
#If Win32 Then
    Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
    (ByVal hwndParent As Long, ByVal fRequest As Long, _
    ByVal lpszDriver As String, ByVal lpszAttributes As String) _
    As Long
#Else
    Private Declare Function SQLConfigDataSource Lib "ODBCINST.DLL" _
    (ByVal hwndParent As Integer, ByVal fRequest As Integer, ByVal _
    lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If


========================================================================
Private Sub CreatODBC()
    #If Win32 Then
          Dim intRet As Long
      #Else
          Dim intRet As Integer
      #End If
      Dim strDriver As String
      Dim strAttributes As String

      strDriver = "SQL Server"
      strAttributes = "SERVER=(local)" & Chr$(0)
      'strAttributes = "SERVER=server" & Chr$(0)
      strAttributes = strAttributes & "DESCRIPTION=DMS" & Chr$(0)
      strAttributes = strAttributes & "DSN=hrm" & Chr$(0)
      strAttributes = strAttributes & "DATABASE=dms_Pay" & Chr$(0)
      'SQL ATHONTICATION
        'strAttributes = strAttributes & "UID=sa" & Chr$(0)
        'strAttributes = strAttributes & "PWD=swtcardio" & Chr$(0)
      'WINDOWS_AUTONTICATION
      strAttributes = strAttributes & "Trusted_Connection=Yes" & Chr$(0)
      intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, _
      strDriver, strAttributes)
      If intRet Then
          'MsgBox "DSN Created"
      Else
          MsgBox "DSN Create Failed", vbCritical, "Cannot Proceeed"
          Exit Sub
      End If
End Sub
=============================================================
devpowerencript
==============================================================
LIST VIEW FORM LOAD

ListView1.ColumnHeaders.Add , , "SID", 0
ListView1.ColumnHeaders.Add , , "EMP NO", 1500
ListView1.ColumnHeaders.Add , , "YEAR", 1500
ListView1.ColumnHeaders.Add , , "MONTH", 1500
ListView1.ColumnHeaders.Add , , "PAYMENT MADE", 1500
ListView1.ColumnHeaders.Add , , "RIGHT P CONTACT", 1500
ListView1.ColumnHeaders.Add , , "PICK UP", 1500
ListView1.View = lvwReport

==================================================================
Call ViewData("SELECT * FROM DMS_PAY..STAFF_DEPLOYMENTS WHERE     (SAL_YEAR = '" & Cmb_Year & "') AND (SAL_MONTH = '" & Cmb_Month & "') AND (PAY_DEPT = '" & CmbDept & "') AND (PAY_SEC = '" & CmbSec & "') ORDER BY PAY_EMPNO", ListView1, 21)

===================================================================
Public Sub ViewData(ByVal strSql As String, ByRef lvwList As ListView, Optional IntFlage As Integer)
lvwList.ListItems.clear
If PAYRS2.State = 1 Then PAYRS2.Close
    Set PAYRS2 = ObjDataAccess.FGetRecords(strSql)
    If PAYRS2.EOF = True Then
        GoTo exit_here
    Else
        While Not PAYRS2.EOF
              If IntFlage = 21 Then
                Set ItemX = lvwList.ListItems.Add(, , Trim(PAYRS2.Fields(0)))
                ItemX.SubItems(1) = Trim(PAYRS2.Fields(1))
                ItemX.SubItems(2) = Trim(PAYRS2.Fields(2))
                ItemX.SubItems(3) = Trim(PAYRS2.Fields(3))
                ItemX.SubItems(4) = Trim(PAYRS2.Fields(4))
                ItemX.SubItems(5) = Trim(PAYRS2.Fields(5))
                ItemX.SubItems(6) = Trim(PAYRS2.Fields(6))
            End If
           PAYRS2.MoveNext
        Wend
    End If

exit_here:
End Sub
===================================================================
LIST VIEW DOUBLE CLICK
Text_Description.Text = Listview.SelectedItem.Text
Text_Rate.Text = Listview.SelectedItem.ListSubItems(1).Text

Listview.ListItems.Remove (Listview.SelectedItem.Index)

example of project
Download example Project