-
1 Attachment(s)
Array Advice!
I've realized that for this specific project, I really need to use arrays which are built dynamically. I have never used them, however, and it is keeping me from polishing off this project.
The attached form [see code below] allows the user to select multiple rows from the obligee listbox OR the principal listbox, and when the user clicks the "Search" button, it will build a query based on the select obligees or principals, and populate a form with data based on the search criteria.
So, basically, I need an array in which to store selected obligees and/or principals.
If someone could at least give me a little clue as to how to safely do this, I will be able to figure it out alright. This site wasn't working for me yesterday ;), so I was at quite a loss. I need to get this down in order to finish this project ASAP, but of course my MSDN library doesn't contain any array info and needs to be updated, blah blah blah.
I greatly appreciate any help...
~Mike
===============CODE==================
Dim rsObligee As ADODB.Recordset
Dim rsPrincipal As ADODB.Recordset
Dim rsPeriod As ADODB.Recordset
Dim numObligee As Integer
Dim numPrincipal As Integer
Dim strBondItem As String
Dim strBondNum As String
Dim BondNum As Integer
Dim BondItem As Integer
Dim Obligee_Array() As String 'Obligee array then stored in strBondCriteria
Dim Principal_Array() As String 'Principal array then stored in strBondCriteria
Private Sub cmdSearch_Click()
Dim i As Integer
With lstObligee
numObligee = .SelCount
If Not .SelCount = 0 Then
ReDim Obligee_Array(1 To numObligee)
For i = LBound(Obligee_Array) To UBound(Obligee_Array)
If numObligee = 1 Then
Out = .List(.ListIndex)
Else: Out = Out & ", " & .List(.ListIndex)
End If
Next i
' For numObligee = 1 To .SelCount 'loops as many times as there are selected items
'
' selObligee = .List(.ListIndex)
'
' If numObligee = 1 Then
' Out = .List(.ListIndex)
' Else: Out = Out & ", " & .List(.ListIndex)
'
' End If
'
' Next numObligee
'
strBondCriteria = Out
strBondCriteria = "'" & strBondCriteria & "'"
If lstObligee.SelCount > 1 Then
strBondCriteria = "Obligee_name = " & "' strBondCriteria '" & "' selObligee '"
Else
strBondCriteria = "Obligee_name = " & strBondCriteria
End If
End If
End With
With lstPrincipal
If Not .SelCount = 0 Then
'strBondCriteria = " Principal_name = "
selPrincipal = .List(.ListIndex)
For numPrincipal = 0 To .SelCount
If numPrincipal = 0 Then
Out = .List(numPrincipal)
Else: Out = Out & ", " & .List(numPrincipal)
End If
Next
strBondCriteria = Out
strBondCriteria = " Principal_name = " & strBondCriteria & selPrincipal
End If
End With
'End If
Call OptionString
'strBondCriteria = strBondCriteria 'Append to ALL rs*.Open commands in frmBond
frmBond.Show
If Not txtBondNumber.Text = "0000000" Then
BondNum = txtBondNumber.Text
strBondNum = "Bond_number = " & "' BondNum '"
strBondCriteria = strBondCriteria & " AND " & "' BondNum '"
End If
If Not txtBondItem.Text = "0000" Then
BondItem = txtBondItem.Text
strBondItem = "Bond_number = " & "' BondItem '"
strBondCriteria = strBondCriteria & " AND " & "' BondItem '"
End If
End Sub
Public Sub OptionString()
If optModify.Value = True Then strBondAction = "Modify"
'End If
If optRenew.Value = True Then strBondAction = "Renew"
'End If
If optView.Value = True Then strBondAction = "View"
'End If
If optCorrect.Value = True Then strBondAction = "Correct"
'End If
End Sub
Private Sub Form_Load()
'frmMain.mnuFileCloseSave.Enabled = 0
'frmMain.mnuFilePrint.Enabled = 0
'frmMain.mnuEditUndo.Enabled = -1
'frmMain.mnuEditRedo.Enabled = -1
'frmMain.mnuEditCopy.Enabled = -1
'frmMain.mnuEditPaste.Enabled = -1
'frmMain.mnuEditCut.Enabled = -1
'frmMain.mnuEditSelectAll.Enabled = -1
'frmMain.mnuEditFirst.Enabled = 0
'frmMain.mnuEditPrevious.Enabled = 0
'frmMain.mnuEditNext.Enabled = 0
'frmMain.mnuEditLast.Enabled = 0
'frmMain.mnuEditInsert.Enabled = 0
'frmMain.mnuEditDelete.Enabled = 0
'frmMain.mnuCalculator.Enabled = 0
'If chkIncCancdBonds.Value = vbChecked Then 'If Cancelled bonds are to be included in the search
'*************************************************************************************
'*************************************************************************************
strCriteriaQuery = "SELECT Bond FROM Bond"
'Sets Selected action based on menu item selected
If optSelect = "Modify" Then optModify.Value = True
If optSelect = "View" Then optView.Value = True
If optSelect = "Renew" Then
optRenew.Value = True
lstPeriod.Visible = True
End If
If optSelect = "Correct" Then optCorrect.Value = True
'************************************************
Set rsObligee = New ADODB.Recordset
rsObligee.Open "SELECT DISTINCT Obligee_name FROM Bond", Cnn1, adOpenKeyset, adLockOptimistic ', adCmdTable
With rsObligee
.MoveFirst
Do While Not .EOF
lstObligee.AddItem rsObligee("Obligee_name").Value
lstObligee.Text = IfIsNull(.Fields("Obligee_name").Value, "")
.MoveNext
If .EOF Then
lstPrincipal.ListIndex = 0
End If
Loop
End With
Set rsObligee = Nothing
Set rsPrincipal = New ADODB.Recordset
rsPrincipal.Open "SELECT DISTINCT Principal_name FROM Bond", Cnn1, adOpenKeyset, adLockOptimistic ', adCmdTable
With rsPrincipal
.MoveFirst
Do While Not .EOF
lstPrincipal.AddItem rsPrincipal("Principal_name").Value
lstPrincipal.Text = IfIsNull(.Fields("Principal_name").Value, "")
.MoveNext
If .EOF Then
lstPrincipal.ListIndex = 0
End If
Loop
End With
Set rsPrincipal = Nothing
'*************************************************************************************
'End If
Set rsPeriod = New ADODB.Recordset
rsPeriod.Open "SELECT Month_date FROM Accounting_Date", Cnn1, adOpenKeyset, adLockOptimistic ', adCmdTable
With rsPeriod
.MoveFirst
Do While Not .EOF
lstPeriod.AddItem rsPeriod("Month_date").Value
lstPeriod.Text = IfIsNull(.Fields("Month_date").Value, "")
.MoveNext
If .EOF Then
lstPeriod.ListIndex = 0
End If
Loop
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
==========END CODE================