Article ID: 150058
Article Last Modified on 10/11/2006
Option Explicit
Dim objAccess As Object
Sub GetAccessReportList()
Dim dbs As Object
Dim strDBName As String
Dim intReport As Integer
Set objAccess = CreateObject("Access.Application.7")
strDBName = DialogSheets(1).EditBoxes(1).Text
If Right$(strDBName, 4) <> ".mdb" And _
Right$(strDBName, 4) <> ".mda" Then
strDBName = strDBName & ".mdb"
End If
With objAccess
.OpenCurrentDatabase (strDBName)
Set dbs = .DBengine(0)(0)
With dbs.Containers("Reports")
For intReport = 0 To .Documents.Count - 1
If Left$(.Documents(intReport).Name, 4) <> "~TMP" Then
DialogSheets(1).ListBoxes(1).AddItem Text:= _
.Documents(intReport).Name
End If
Next intReport
End With
End With
End Sub
Sub Main()
DialogSheets(1).ListBoxes(1).RemoveAllItems
DialogSheets(1).Show
End Sub
C:\Msoffice\Access\Samples\Northwind.mdb
Sub GetAccessReportList()
Dim lstReports As list box
Dim strDBName As String
Dim intReport As Integer
Dim docReports As Object
Dim intCount As Integer
Dim strDoc As String
Set lstReports = DialogSheets(1).ListBoxes(1)
Set objAccess = CreateObject("Access.Application.7")
strDBName = DialogSheets(1).EditBoxes(1).Text
If Right$(strDBName, 4) <> ".mdb" And _
Right$(strDBName, 4) <> ".mda" Then
strDBName = strDBName & ".mdb"
End If
objAccess.OpenCurrentDatabase strDBName
With objAccess.DBengine(0)(0)
Set docReports = .Containers("Reports").Documents
intCount = docReports.Count - 1
For intReport = 0 To intCount
strDoc = docReports.Item(intReport).Name
If Left$(strDoc, 4) <> "~TMP" Then
lstReports.AddItem Text:=strDoc
End If
Next
End With
End Sub147816 ACC: Using Microsoft Access as an OLE Automation Server
Keywords: kberrmsg kbprogramming KB150058