Hi everybody,
The following problem occurred: I build two database for gathering information from two sectors of our organization. A third database is used as a management tool to open the most important reports of both databases. By pressing on a button in the third database, code below opens one of the external databases and the desired report. After that, the code creates a menubar with to buttons. The first one should open the print window and the second button should close the external database, but I don't seem to be able to get the buttons working. Any suggestions? Thanks!
Option Explicit
Function PrintExternalReport(ByVal oString As String, ByVal iDb As Integer)
Dim appAccess As Access.Application
Dim oStrDb As String
Dim oErr As String
Dim i As Integer
Dim myBar As CommandBar
On Error GoTo PrintExternalreport_ErrHandler
Set appAccess = CreateObject("Access.Application")
If iDb = 1 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database1.mdb"
ElseIf iDb = 2 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database2.mdb"
End If
appAccess.Visible = False
'Open database in Current Microsoft Access window.
appAccess.OpenCurrentDatabase (oStrDb)
appAccess.DoCmd.Close acForm, "Mainmenu"
appAccess.Application.RunCommand acCmdAppMaximize
For i = 1 To appAccess.CommandBars.Count
appAccess.Application.CommandBars(i).Enabled = True
appAccess.Application.CommandBars(i).Enabled = False
Next i
'Open Report
appAccess.DoCmd.OpenReport oString, acViewPreview
Set myBar = appAccess.CommandBars.Add("Close and print", Position:=msoBarTop, MenuBar:=False, Temporary:=True)
With myBar
.Controls.Add Type:=msoControlButton, Id:=4
.Controls.Add Type:=msoControlButton
End With
With myBar.Controls(1)
.Style = msoButtonIconAndCaption
.Caption = "Print"
.OnAction = "=PrintMenu()"
.TooltipText = "Print this report"
End With
With myBar.Controls(2)
.Style = msoButtonCaption
.Caption = "Close"
.OnAction = "=CloseThisDb()"
.TooltipText = "Close"
End With
appAccess.Application.CommandBars("Close and print").Visible = True
appAccess.DoCmd.Maximize
Exit Function
PrintExternalReport_ErrHandler:
If Err.Number = 2501 Then
oErr = "Cancel"
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Resume Next
Else
If oErr = "Cancel" Then
Resume Next
Else: MsgBox Error$(), , Err.Number & " " & Err.Description & "Print Acces Report"
End If
End If
End Function
Function printMenu()
appAccess.DoCmd.RunCommand (acCmdPrint)
End Function
Function CloseThisDb()
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Function
The following problem occurred: I build two database for gathering information from two sectors of our organization. A third database is used as a management tool to open the most important reports of both databases. By pressing on a button in the third database, code below opens one of the external databases and the desired report. After that, the code creates a menubar with to buttons. The first one should open the print window and the second button should close the external database, but I don't seem to be able to get the buttons working. Any suggestions? Thanks!
Option Explicit
Function PrintExternalReport(ByVal oString As String, ByVal iDb As Integer)
Dim appAccess As Access.Application
Dim oStrDb As String
Dim oErr As String
Dim i As Integer
Dim myBar As CommandBar
On Error GoTo PrintExternalreport_ErrHandler
Set appAccess = CreateObject("Access.Application")
If iDb = 1 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database1.mdb"
ElseIf iDb = 2 Then
oStrDb = "\\xxx.xxx.xxx.xxx\database2.mdb"
End If
appAccess.Visible = False
'Open database in Current Microsoft Access window.
appAccess.OpenCurrentDatabase (oStrDb)
appAccess.DoCmd.Close acForm, "Mainmenu"
appAccess.Application.RunCommand acCmdAppMaximize
For i = 1 To appAccess.CommandBars.Count
appAccess.Application.CommandBars(i).Enabled = True
appAccess.Application.CommandBars(i).Enabled = False
Next i
'Open Report
appAccess.DoCmd.OpenReport oString, acViewPreview
Set myBar = appAccess.CommandBars.Add("Close and print", Position:=msoBarTop, MenuBar:=False, Temporary:=True)
With myBar
.Controls.Add Type:=msoControlButton, Id:=4
.Controls.Add Type:=msoControlButton
End With
With myBar.Controls(1)
.Style = msoButtonIconAndCaption
.Caption = "Print"
.OnAction = "=PrintMenu()"
.TooltipText = "Print this report"
End With
With myBar.Controls(2)
.Style = msoButtonCaption
.Caption = "Close"
.OnAction = "=CloseThisDb()"
.TooltipText = "Close"
End With
appAccess.Application.CommandBars("Close and print").Visible = True
appAccess.DoCmd.Maximize
Exit Function
PrintExternalReport_ErrHandler:
If Err.Number = 2501 Then
oErr = "Cancel"
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
Resume Next
Else
If oErr = "Cancel" Then
Resume Next
Else: MsgBox Error$(), , Err.Number & " " & Err.Description & "Print Acces Report"
End If
End If
End Function
Function printMenu()
appAccess.DoCmd.RunCommand (acCmdPrint)
End Function
Function CloseThisDb()
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Function