Private Declare Function apiSetForegroundWindow Lib "user32" _ Alias "SetForegroundWindow" _ (ByVal hwnd As Long) _ As Long
Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" _ (ByVal hwnd As Long, _ ByVal nCmdShow As Long) _ As Long
Private Const SW_MAXIMIZE = 3 Private Const SW_NORMAL = 1
Function fOpenRemoteReport(strMDB As String, strReport As String, _ Optional intView As Variant) _ As Boolean ' strMDB: 外部数据库名称(含路径) ' strReport: 报表名称 ' intView: 报表的打开方式
Dim objAccess As access.Application Dim lngRet As Long
On Error GoTo fOpenRemoteReport_Err
If IsMissing(intView) Then intView = acViewPreview
If Len(Dir(strMDB)) > 0 Then Set objAccess = New access.Application With objaccess lngRet = apiSetForegroundWindow(.hWndaccessApp) lngRet = apiShowWindow(.hWndaccessApp, SW_NORMAL) ' 第一次调用ShowWindow似乎不做任何事情 lngRet = apiShowWindow(.hWndaccessApp, SW_NORMAL) .OpenCurrentDatabase strMDB .DoCmd.OpenReport strReport, intView Do While Len(.CurrentDb.Name) > 0 DoEvents Loop End With End If
fOpenRemoteReport_Exit: On Error Resume Next objaccess.Quit Set objaccess = Nothing Exit Function
fOpenRemoteReport_Err: fOpenRemoteReport = False Select Case Err.Number Case 7866: ' mdb 已经被用独占方式打开 MsgBox "该数据库:" & strMDB & _ vbCrLf & "已经被用独占方式打开!" & vbCrLf _ & vbCrLf & "请重新用共享方式打开,再试一次!", _ vbExclamation + vbOKOnly, "不能打开数据库" Case 2103: ' 报表不存在 MsgBox "在这个" & strMDB & "数据库中不存在该报表:" & strReport & _ vbCrLf & vbCrLf , _ vbExclamation + vbOKOnly, "报表不存在" Case 7952: ' 用户关闭了这个 mdb fOpenRemoteReport = True Case Else: MsgBox "错误#: " & Err.Number & vbCrLf & Err.Description, _ vbCritical + vbOKOnly, "运行时错误" End Select Resume fOpenRemoteReport_Exit End Function |