I have been trying to add a series of dates from a table (table has duplicate dates so I need to use VBA to exclude duplicates before adding to combo box). I am using the following code:
Code:
Private Sub Form_Open(Cancel As Integer)
'fill cbxDate with unique dates found in tblCEF_Data
Dim rst As ADODB.Recordset
Dim strQry As String
Dim intCt As Integer
Dim i As Integer
Dim dTmp As Date
Dim strDate As String
Dim strList As String
On Error GoTo ErrorHandler
Const CALLER As String = " Form_frmGetQry:Form_Open "
strQry = "SELECT tblCEF_Data.Date_Of_Rpt" & _
" FROM tblCEF_Data;"
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = CurrentProject.Connection
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open strQry, Options:=adCmdText
End With
If rst.RecordCount > 0 Then
intCt = rst.RecordCount
'init the list
Me.CbxDate.RowSourceType = "Value List" 'need this to use AddItem
Me.CbxDate.RowSource = vbNullString
With rst
.MoveFirst
For i = 1 To intCt
Debug.Print !Date_Of_Rpt
Debug.Print dTmp
If !Date_Of_Rpt = dTmp Then
'do nothing duplicate
Else
'not dupe add then reset var date
strDate = CStr(!Date_Of_Rpt)
strList = strDate
Me.CbxDate.AddItem item:=strDate
dTmp = !Date_Of_Rpt
strList = strList & ";"
Debug.Print Me.CbxDate.Value
End If
.MoveNext
Next i
End With
Debug.Print Me.CbxDate.RowSource
Else
End If
Cleanup:
'put this in Cleanup:
If Not rst Is Nothing Then
If rst.State = adStateOpen Then rst.Close
Set rst = Nothing
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description & vbCrLf & _
Err.Number & vbCrLf & _
"Called By :" & CALLER & vbCrLf & _
Err.Source, VbMsgBoxStyle.vbCritical, "Could not add new name to data base" & vbCrLf & _
"Module Name: = " & ModuleName
GoTo Cleanup
End Sub
When I open the form with the cbx the code runs but no data is visible in cbx.