Updating Listbox in Excel Form
 

Hi there

A listbox on an excel vba based form [frmStrategy] needs to be updated
with text that is entered into a textbox on another smaller form
[frmAddProgramme]. The new record is then appended to a table in
access [tblProgramme].

While I can get the text to save in the access table when I click
'ok', the listbox isn't immediately updating or refreshing so the new
entry appears, even though the data source is the same.. It only
appears if I close the form [frmStrategy] where the listbox sits, and
then re-open it?

Where am I going wrong here? Would really appreciate some help..

Thanks in advance, Sue


'In a separate module (public_var) I have: [


Sub FindDatabasePath()
path1 = "\\xxxxxxxxx\xxxxxxxx\xxxxxxx\xxx\xxxxxxxxx"
path1 = "" & path1 & "" & "\xxxxxxxx - xxxxxxxxxx Database.mdb"
End Sub

'-----------------------------------------------------------------

'Then behind the AddNewProgramme form and OK button I have:

Option Explicit
Dim db As Database
Dim ws As Workspace
Dim rsA1 As Recordset
Dim Project_ID As Integer
Dim Array1()

'-----------------------------------------------------------------

Private Sub cmbok_click()

Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)

Set rsA1 = db.OpenRecordset("Select * from tblProgramme")
With rsA1
.AddNew
.Fields("OverallProgramme") = Me.txOverallProgramme.Value
.Update

End With

rsA1.Close
Unload frmAddProgramme

Call RequeryProgrammeLists


End Sub

'-----------------------------------------------

Sub RequeryProgrammeLists()
Dim strSource As String

Project_ID = frmInput.txProjectID

strSource = "SELECT [tblProgramme].[Programme_ID],[tblProgramme].
[OverallProgramme] FROM tblProgramme INNER JOIN (tblProject INNER JOIN
tblProject_Programme ON [tblProject].[Project_ID] =
[tblProject_Programme].[Project_ID]) ON [tblProgramme].[Programme_ID]
= [tblProject_Programme].[Programme_ID]" _
& " WHERE [tblProject_Programme].[Project_ID] = " & Project_ID &
";"
Call ListArray(strSource)

Me.lstboxAllocatedProgramme.List = Array1
frmInput.lstboxAllocatedProgramme.List = Array1
strSource = "SELECT * FROM tblProgramme WHERE [tblProgramme].
[Programme_ID] NOT IN (SELECT tblProject_Programme.Programme_ID FROM
tblProject_Programme WHERE [tblProject_Programme].[Project_ID] = " &
Project_ID & ");"

Call ListArray(strSource)
Me.lstboxAvailableProgramme.List = Array1


End Sub

'-----------------------------------------------

Sub ListArray(strSource As String)
Set ws = DBEngine.Workspaces(0)
Call FindDatabasePath
Set db = ws.OpenDatabase(path1)
Set rsA1 = db.OpenRecordset(strSource)


Dim R As Integer
Dim C As Integer
Dim i As Integer

If rsA1.EOF Then
ReDim Array1(0, 0)
Exit Sub
Else

rsA1.MoveLast
R = rsA1.RecordCount - 1
C = rsA1.Fields.Count - 1
rsA1.MoveFirst

ReDim Array1(R, C)

R = 0
i = 0
Do While Not rsA1.EOF

For i = 0 To C
On Error Resume Next
Array1(R, i) = rsA1.Fields(i)
Next i

rsA1.MoveNext
R = R + 1
Loop
rsA1.Close

Set rsA1 = Nothing
End If
End Sub