• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• ' FILL COMBO IN ONE FUNCTION SENDING THROUGH COMBO BOX NAME ,FILE NAME, NUMERIC FIELD , SRTING FILE

' FILL COMBO IN ONE FUNCTION SENDING THROUGH COMBO BOX NAME ,FILE NAME, NUMERIC FIELD , SRTING FILE

' FILL COMBO IN ONE FUNCTION SENDING THROUGH COMBO BOX NAME ,FILE NAME, NUMERIC FIELD , SRTING FILED ' FOR FURTHER INFORMATION CONTACT

API Declarations


Dim AdoTmp As ADODB.Recordset
Public AdoConn As ADODB.Connection



Rate ' FILL COMBO IN ONE FUNCTION SENDING THROUGH COMBO BOX NAME ,FILE NAME, NUMERIC FIELD , SRTING FILE

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

   Set obj = New ADODB.Recordset
   obj.ActiveConnection = ADO_Conn
   obj.CursorType = adOpenKeyset
   obj.LockType = adLockOptimistic
End Sub

Public Sub Open_ADORS(obj As ADODB.Recordset, qry As String)
   With obj
      If .State = adStateOpen Then .Close
          .Open qry, , , adCmdText
    End With
End Sub

Public Sub FillCombo(Combo As ComboBox, Optional FillType As String, Optional _
   FileName As String, Optional Field1 As String, Optional Field2 As String _
   , Optional OBy As Boolean, Optional Fill_Field_Name As String, Optional FillValue As Long)
   
 
   Set_ADORS AdoTmp, AdoConn
   qry = "Select " & IIf(Field1 = "", "Code", Field1) & " as PrdCode ," _
      & IIf(Field2 = "", "Name", Field2) & " as PrdName From " & IIf(FileName = "", "AllinOne", FileName)
      If Fill_Field_Name = "" Then
         If FillType <> "" Then
            qry = qry & "  Where Type='" & UCase(FillType) & "' "
         End If
      Else
         qry = qry & "  Where " & Fill_Field_Name & "=" & FillValue
      End If
      If OBy = True Then
         qry = qry & " Order By " & IIf(Field2 = "", "Name", Field2)
      End If
   Open_ADORS AdoTmp, qry
   With Combo
      .Clear
      .Visible = False
      If AdoTmp.RecordCount < 1 Then .Visible = True: StBarMsg ClearStbar: Exit Sub
      While Not AdoTmp.EOF
         .AddItem AdoTmp!PrdName
         .ItemData(.NewIndex) = AdoTmp!Prdcode
         AdoTmp.MoveNext
      Wend
      .ListIndex = 0
      .Visible = True
      StBarMsg ClearStbar
   End With
End Sub