Access data viewed in a listbox

[Peter L Kessler]

Hi Group

I have my Word97/2000 user form linked to an Access database. All the data
is pulled into a listbox on the user form. All of the twelve columns of data
are hidden except the one containing company names.

What I would like to do is make this listbox show the data in the format
"company name" + ", " + "contact name" in one column with no gaps other than
those shown here. Do you have any idea as to how I would go about altering
the listbox's display in this way, and in a way that would not effect the
listbox_Click event, when data selected by the user is copied to a series of
textboxes on the user form?

Best wishes
Peter




Kessler Associates
E: [email protected]
W: http://homepages.tesco.net/~plk33/plk33/index.htm

 

[Doug Robbins - Word MVP]

Hi Peter,

The easiest thing to do will be create a query in access that contains that
expression and load it plus the other 12 columns into the listbox.

Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Peter L Kessler]

Hi Doug

Thanks for the suggestion. I am very reluctant to do this however. Firstly,
because it seems to be a complication too far for me, let alone the simple
user. Secondly, because I don't have any control over how the users of my
script will deal with their Access database. All I can do is suggest the
most simple Query, which I already have working.

I would like to be able to manipulate how the Access data is displayed in my
listbox from within my Word VBA script. I have the same problem with
displaying data from an Excel spreadsheet, so I need to be able to set VBA
script for listing both of these in my chosen format from inside Word. Do
you know of a way of doing this?

Best wishes
Peter




Kessler Associates
E: [email protected]
W: http://homepages.tesco.net/~plk33/plk33/index.htm

 

[Doug Robbins - Word MVP]

Hi Peter,

Being a masochist, I put this together for you. I can't imagine how you
would think that creating an expression in a query in Access would be more
complicated

Private Sub UserForm_Activate()
'allocate memory for the database object as a whole and for the active
record
Dim myDataBase As Database
Dim myActiveRecord As Recordset
Dim i As Integer, j As Integer, m As Integer, n As Integer
Dim mystring As String
'Open a database
Set myDataBase = OpenDatabase("D:\Access\ResidencesXP.mdb")
'Access the first record from a particular table
Set myActiveRecord = myDataBase.OpenRecordset("Owners", dbOpenForwardOnly)
'Get the number of fields in the table
j = myActiveRecord.Fields.Count + 1
'Get the number of Records in the table
'Loop through all the records in the table until the end-of-file marker is
reached
i = 0
Do While Not myActiveRecord.EOF
i = i + 1
'access the next record
myActiveRecord.MoveNext
Loop
myActiveRecord.Close
'Set the number of columns in the listbox
ListBox1.ColumnCount = j
' Define an array to be loaded with the data
Dim MyArray() As Variant
'Load data into MyArray
ReDim MyArray(i, j)
Set myActiveRecord = myDataBase.OpenRecordset("Owners", dbOpenForwardOnly)
m = 0
Do While Not myActiveRecord.EOF
mystring = myActiveRecord.Fields(1)
For n = 2 To j - 3
mystring = mystring & ", " & myActiveRecord.Fields(n)
Next n
mystring = mystring & ", " & myActiveRecord.Fields(j - 2)
MyArray(m, 0) = mystring
m = m + 1
myActiveRecord.MoveNext
Loop
myActiveRecord.Close
For n = 1 To j - 3
Set myActiveRecord = myDataBase.OpenRecordset("Owners",
dbOpenForwardOnly)
m = 0
Do While Not myActiveRecord.EOF
MyArray(m, n) = myActiveRecord.Fields(n + 1)
m = m + 1
myActiveRecord.MoveNext
Loop
Next n
' Load data into ListBox1
ListBox1.List() = MyArray
'Then close the database
myActiveRecord.Close
myDataBase.Close
End Sub

Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Peter L Kessler]

Hi Doug

I realise I'm sounding "difficult" by not wanting to handle Access Queries,
but the truth is I have no control over how users will set up their
databases. All I can hope to do is manipulate the way the basic data is used
within Word VBA. Hopefully you'll bear with me on this!

Thanks very much for your "fix" I managed to integrate it very easily, and
then spent a little time getting to know just how the data was being
handled.

It works perfectly, and displays the data as I wanted by adding columns 2
and 1 (Company+Name) of the database. The problem is that now when I click
on an entry in the listbox, the visible entry is Company+Name and this is
what is transferred to the "Name" textbox, when all I need there is the Name
on it's own (column 1).

I've tried all morning to work around this without any success, so is this
solvable, or will my head explode before I fix it? My current code is shown
below this message.

Best wishes
Peter




Kessler Associates
E: [email protected]
W: http://homepages.tesco.net/~plk33/plk33/index.htm


****************************************

Private Sub optDB_Click() 'View database details in listbox

' Some settings removed here for the sake of brevity

' strDBPath is my database path
' strDBTable is my table name
' strDBQuery is my query name
' db is my database
' rs is my recordset

Dim i As Integer
Dim rs As Recordset
Dim db As Database
Dim NoOfRecords As Long
Dim MyString As String

' Open the database
Set db = OpenDatabase(name:=strDBPath)


Dim j As Integer, m As Integer, n As Integer
' Access the first record from a particular table
Set rs = db.OpenRecordset(strDBQuery, dbOpenForwardOnly)
' Get the number of fields in the table
j = rs.Fields.count + 1 '+1 added for 'Company, Name' listing

' Get the number of Records in the table
' Loop through all the records in the table until the end-of-file
marker is reached
i = 0
Do While Not rs.EOF
i = i + 1
' Access the next record
rs.MoveNext
Loop
rs.Close

' Set the number of columns in the listbox
'lstCompany is my listbox
lstCompany.ColumnCount = j

lstCompany.Clear

' Get the number of records
' Define an array to be loaded with the data
Dim MyArray() As Variant
' Load data into MyArray
ReDim MyArray(i, j)

Set rs = db.OpenRecordset(strDBQuery, dbOpenForwardOnly)
m = 0
Do While Not rs.EOF
MyString = rs.Fields(2)
For n = 2 To j
If rs.Fields(1) <> "" Then
MyString = rs.Fields(2) & ", " & rs.Fields(1) 'Company
name, Name
Else
MyString = rs.Fields(2) 'Company name only
End If
Next n
MyArray(m, 0) = MyString
m = m + 1
rs.MoveNext
Loop
rs.Close

For n = 1 To j - 3
Set rs = db.OpenRecordset(strDBQuery, dbOpenForwardOnly)
m = 0
Do While Not rs.EOF
MyArray(m, n) = rs.Fields(n + 1)
m = m + 1
rs.MoveNext
Loop
Next n

' Load data into ListBox1
lstCompany.List() = MyArray
' Set widths of individual columns in the listbox
lstCompany.ColumnWidths = ";" & 0 & ";" & 0 & ";" & 0 & ";" _
& 0 & ";" & 0 & ";" & 0 & ";" & 0 & ";" & 0 & ";" & 0 & ";" & 0 &
";" & 0
lstCompany.ColumnCount = 1
lstCompany.ColumnWidths = -1 'Resets default

rs.Close
db.Close

End Sub




Private Sub lstCompany_Click()

If Me.optDB Then 'database is being viewed in lstCompany
With rs 'MyRecordSet
'.Seek Array(strKey), adSeekFirstEQ
' If .EOF Then
' MsgBox "Unable to seek to: " & ", Company: " &
strKey, vbOKOnly, Me.Caption
' GoTo Ending
' End If

' Populate Form controls
txtToAddress2.Text =
AssignBlankIfNull(lstCompany.Column(0)) 'Name
txtToAddress3.Text =
AssignBlankIfNull(lstCompany.Column(1)) 'Company
txtToAddress4.Text =
AssignBlankIfNull(lstCompany.Column(2)) 'Address1
txtToAddress5.Text =
AssignBlankIfNull(lstCompany.Column(3)) 'Address2
txtToAddress6.Text =
AssignBlankIfNull(lstCompany.Column(4)) 'Address3
txtToAddress7.Text =
AssignBlankIfNull(lstCompany.Column(5)) 'City
txtToAddress8.Text =
AssignBlankIfNull(lstCompany.Column(7)) 'Post Code
' txtToAddress9.Text =
AssignBlankIfNull(lstCompany.Column(9))
txtToAddress10.Text =
AssignBlankIfNull(lstCompany.Column(11)) 'Fax
txtToAddress11.Text =
AssignBlankIfNull(lstCompany.Column(10)) 'Tel
txtToAddress12.Text =
AssignBlankIfNull(lstCompany.Column(6)) 'County
txtToAddress13.Text =
AssignBlankIfNull(lstCompany.Column(8)) 'Country
End With
End If

End Sub

 

[Doug Robbins - Word MVP]

Hi Peter,

I don't understand if you "have no control over how users will set up their
databases", how you can rely on the strDBQuery being what your code is
expecting it to be?

However, in addition to having a column in the list that contains Company +
Name, you also need separate columns for each of Company and Name. Looking
at the code again, to get each of the fields in the query into a column in
the list, the following part of the code :

For n = 1 To j - 3
Set rs = db.OpenRecordset(strDBQuery, dbOpenForwardOnly)
m = 0
Do While Not rs.EOF
MyArray(m, n) = rs.Fields(n + 1)
m = m + 1
rs.MoveNext
Loop
Next n

should be changed to:

For n = 1 To j - 2
Set rs = db.OpenRecordset(strDBQuery, dbOpenForwardOnly)
m = 0
Do While Not rs.EOF
MyArray(m, n) = rs.Fields(n)
m = m + 1
rs.MoveNext
Loop
Next n

Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Peter L Kessler]

Hello Doug

Brilliant, Doug. I actually managed to add this in and get it to work in
just a few minutes. Must be some kind of record for me!

strDBQuery, and all the other strings regarding database names and file
locations are set by user input or by reading Registry entries. On first
use, the user is presented with a dialogue which prompts them to locate the
path and file name of their database, and then prompts them for the table
name they wish to link to. The same is true of query names, so that users
can have any name they wish, but as long as the format is correct (the right
number of columns, with the right names, as specified in my user guide
documents) their database will work with my script.

Now, to make things even more complicated, I have to get the same thing
working for Word 2000. Because the intended users of this script are split
on two different versions of Word I have to write all this so it will work
for users with either/or versions of Word. At present I have the two working
scripts which connect to Access through Word 97 and Word 2000. Now I also
have the query version working in 97, and have managed to get it working in
2000 (I know it sounds long winded, but it works so far. Hopefully you won't
mind me asking for more help with this). But I can't click on a listbox
entry in the 2000 version to get that entry to display in the textboxes.

The Access connection script I have is repeated below, as is the lstCompany
script. I think that for a programmer it will be easy to amend so that it
reads the lastbox data and transferrs the required entry to the textboxes.
Unfortunately I've already spent the best part of another day trying this
with no luck...

Best wishes
Peter L Kessler
[email protected]

(My usual address, [email protected] is going to be rested temporarily to
help my fight against masses of spam, so please use my home address if you
need to.)



*****************************************
'Word 2000 connection to Access database
Private Sub optDB_Click()

' Clear object to free up memory
Set mrstAddressees = Nothing
Set mcnnCESurvey = Nothing

' ADO database connection using Jet provider for an Access db
mcnnCESurvey.ConnectionString = Replace$(mcDBConnectionString, "%1",
strDBPath)

mcnnCESurvey.Open

If mcnnCESurvey.State <> adStateOpen Then
MsgBox "Failed to establish database connection: " & _
strDBPath, vbInformation
Exit Sub
End If

lstCompany.Clear

With mrstAddressees 'MyRecordSet
' .Open strDBTable, mcnnCESurvey, _
'This is the only change I made to get this connection working for a
query
.Open strDBQuery, mcnnCESurvey, _
adOpenKeyset, adLockOptimistic, adCmdTableDirect
'.Index = "PrimaryKey"

.MoveFirst
Do Until .EOF
' If Company name exists
If ![Company] <> "" Then
' If Name exists, add both together
If ![Company] <> "" Then
lstCompany.AddItem ![Company] & ", " & ![name]
lstCompany.List(lstCompany.ListCount - 1, 1) = ![ID]
Else
lstCompany.AddItem ![Company]
lstCompany.List(lstCompany.ListCount - 1, 1) = ![ID]
End If
End If
.MoveNext
Loop
End With


'And without a Query, this is how an entry is transferred to the textboxes
in Word 2000:

lstCompany_Click()
Dim strKey As String

With lstCompany
If .ListIndex < 0 Then GoTo Ending
strkey = .List(.ListIndex, 1)
End With

With mrstAddressees 'MyRecordSet
.Seek Array(strkey), adSeekFirstEQ
If .EOF Then
MsgBox "Unable to seek to: " & ", Company: " &
strkey, vbOKOnly, Me.Caption
GoTo Ending
End If

' Populate Form controls
txtToAddress2.Text = AssignBlankIfNull(![name])
txtToAddress3.Text = AssignBlankIfNull(![Company])
txtToAddress4.Text = AssignBlankIfNull(![ADDRESS1])
txtToAddress5.Text = AssignBlankIfNull(![ADDRESS2])
txtToAddress6.Text = AssignBlankIfNull(![ADDRESS3])
txtToAddress7.Text = AssignBlankIfNull(![City])
txtToAddress8.Text = AssignBlankIfNull(![PostCode])
txtToAddress10.Text = AssignBlankIfNull(![Fax])
txtToAddress11.Text = AssignBlankIfNull(![TEL])
txtToAddress12.Text = AssignBlankIfNull(![County])
txtToAddress13.Text = AssignBlankIfNull(![Country])
End With
End Sub

Public Function AssignBlankIfNull(ByVal varValue As Variant) As String

AssignBlankIfNull = IIf(IsNull(varValue), vbNullString, varValue)

End Function ' AssignBlankIfNull

 

[Peter L Kessler]

Hi

After more work I managed to amend some of the script which calls my query
data from the Access database. I found that by adding a series of Ifs I
could successfully pull in the required data when I clicked on a listbox
entry. But, it only works while the ListCount values stay in single figures,
ie "-1, 4", but double figures cause an error, ie "-1,11". Unfortunately
that means this won't work unless I can find a way of pulling in the higher
values. All this is replicated below, so I hope it will be easy to provide
an answer. I certainly need one!

Best wishes
Peter




Kessler Associates
E: [email protected]
W: http://homepages.tesco.net/~plk33/plk33/index.htm



Amended script:

With mrstAddressees 'MyRecordSet
.Open strDBQuery, mcnnCESurvey, _
adOpenKeyset, adLockOptimistic, adCmdTableDirect
'.Index = "PrimaryKey"

.MoveFirst
Do Until .EOF
' If Company name exists
If ![Company] <> "" Then
' If Name exists, add both together
If ![Company] <> "" Then
lstCompany.AddItem ![Company] & ", " & ![name]
If ![name] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 1) =
![name]
If ![Company] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 2) =
![Company]
If ![ADDRESS1] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 3) =
![ADDRESS1]
If ![ADDRESS2] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 4) =
![ADDRESS2]
If ![ADDRESS3] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 5) =
![ADDRESS3]
If ![City] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 6) =
![City]
If ![PostCode] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 8) =
![PostCode]
' If ![Fax] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 10) =
![Fax]
' If ![tel] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 11) =
![TEL]
' If ![county] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 12) =
![County]
' If ![Country] <> "" Then _
lstCompany.List(lstCompany.ListCount - 1, 13) =
![Country]
'lstCompany.List(lstCompany.ListCount - 1, 1) =
![ID]
Else
lstCompany.AddItem ![Company]
lstCompany.List(lstCompany.ListCount - 1, 1) = ![ID]
End If
End If
.MoveNext
Loop
End With