Creating a Multidimensional Array in Word

Question

I am using a list of cases in Access 2010 (contained in a query) to fill in a listbox on an UserForm in Word.  This process can take a very long time even though the number of records never exceeds 100.  We are calling on that UserForm all of the time, so we need to recreate the listbox repeatedly.  I want to create a 2 column multidimensional array once and then use that to re-initialize the listbox; the number of records changes all of time.  This one-time array should save a lot of time.

I include my current code for initializing the form below.

Here is my current in-process code (that still doesn't work) for creating the permanent array (and I assume has many defects since I have little experience with arrays):

Function MakeArrayOfActiveCases() As String

Dim SqlStr As String

SqlStr = "SELECT * FROM ActiveCasesQuery"

Dim cn As ADODB.Connection

Dim ArrayRecords As ADODB.Recordset

Dim i As Long

Set cn = New ADODB.Connection

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & _

"c:\accesslocal\WordData.accdb" & ";"

Set ArrayRecords = New ADODB.Recordset

'With Rst

ArrayRecords.Open SqlStr, cn, adOpenStatic, adLockOptimistic, adCmdText

ArrayRecords.MoveFirst

i = 0

Do

'see http://www.fontstuff.com/vba/vbatut10.htm

Dim WordCaseList() As Variant

'Dim i As Long

For i = 0 To ArrayRecords.RecordCount - 1

WordCaseList(i, 0) = CStr(ArrayRecords!CaseID)

WordCaseList(i, 1) = ArrayRecords!CaseName

Next i

ArrayRecords.MoveNext

Loop Until ArrayRecords.EOF

ArrayRecords.Close

Set rst = Nothing

cn.Close

Set cn = Nothing

ReDim Preserve WordCaseList(0 To NumOfCases, 0 To NumOfCases) As Variant

MsgBox WordCaseList

End Function

Here is my code for initializing the listbox (which works fine, but takes forever):

Sub ChangetheCaseName()

Dim SqlStr As String

Dim CurrentCaseName As String

Dim OrderClause As String

AssignUser

OrderClause = " ORDER BY CaseName"

SqlStr = "SELECT * FROM ActiveCasesQuery" ' & OrderClause

Dim cn As ADODB.Connection

Dim rst As ADODB.Recordset

Dim i As Long

Set cn = New ADODB.Connection

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & _

"c:\accesslocal\WordData.accdb" & ";"

Set rst = New ADODB.Recordset

'With Rst

rst.Open SqlStr, cn, adOpenStatic, adLockOptimistic, adCmdText

rst.MoveFirst

i = 0

'see http://www.fontstuff.com/vba/vbatut10.htm

Do

With CaseNames

.AddItem

.list(i, 0) = rst!CaseID

.list(i, 1) = rst!CaseName

i = i + 1

End With

rst.MoveNext

Loop Until rst.EOF

rst.Close

Set rst = Nothing

cn.Close

Set cn = Nothing

End Sub

TIA!

Answer 1

Redefine the Query, or create a new one, so that it outputs only the required fields.

Answer 2

Thanks, but...

This solution, as I read it, would supply my listbox with a column for every field.   This is not what I am looking for.

I only need two fields (CaseID and CaseName) for my 2 column listbox; I will fill those columns with the relevant data from the query's records.

Answer 3

Try replacing:

rst.MoveFirst

i = 0

'see http://www.fontstuff.com/vba/vbatut10.htm

Do

With CaseNames

.AddItem

.list(i, 0) = rst!CaseID

.list(i, 1) = rst!CaseName

i = i + 1

End With

rst.MoveNext

Loop Until rst.EOF

with

With rst

    .MoveLast

    NoOfRecords = .RecordCount

    .MoveFirst

End With

With CaseNames

   'Set the number of columns = number of fields in the recordset

   .ColumnCount = rst.Fields.Count

   'Load the listbox with the retrieved records

   .Column = rst.GetRows(NoOfRecords)

End With

You may need to include

Dim NoOfRecords as Long