'********* Code Start *********** ' This code was originally written by Dev Ashish. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Dev Ashish
Private Declare Function SetKeyboardState _ Lib "user32" _ (lppbKeyState As Any) _ As Long Private Declare Function GetKeyboardState _ Lib "user32" (pbKeyState As Any) _ As Long
Private Declare Function GetWindowThreadProcessId _ Lib "user32" _ (ByVal hWnd As Long, _ lpdwProcessId As Long) _ As Long
Private Declare Function AttachThreadInput _ Lib "user32" _ (ByVal idAttach As Long, _ ByVal idAttachTo As Long, _ ByVal fAttach As Long) _ As Long
Private Declare Function SetForegroundWindow _ Lib "user32" _ (ByVal hWnd As Long) _ As Long
Private Declare Function SetFocusAPI _ Lib "user32" Alias "SetFocus" _ (ByVal hWnd As Long) _ As Long
Private Const VK_SHIFT = &H10 Private Const VK_LSHIFT = &HA0 Private Const VK_RSHIFT = &HA1
Function fGetRefNoAutoexec( _ ByVal strMDBPath As String) _ As Access.Application On Error GoTo ErrHandler Dim objAcc As Access.Application Dim TIdSrc As Long, TIdDest As Long Dim abytCodesSrc(0 To 255) As Byte Dim abytCodesDest(0 To 255) As Byte
If (Len(Dir$(strMDBPath, vbNormal)) = 0) Then Err.Raise 53 End If
Set objAcc = New Access.Application With objAcc .Visible = True
' attach to process TIdSrc = GetWindowThreadProcessId( _ Application.hWndAccessApp, ByVal 0) TIdDest = GetWindowThreadProcessId( _ .hWndAccessApp, ByVal 0) If CBool(AttachThreadInput(TIdSrc, TIdDest, True)) Then Call SetForegroundWindow(.hWndAccessApp) Call SetFocusAPI(.hWndAccessApp) ' 设置Shift状态 Call GetKeyboardState(abytCodesSrc(0)) Call GetKeyboardState(abytCodesDest(0)) abytCodesDest(VK_SHIFT) = 128 Call SetKeyboardState(abytCodesDest(0)) ' 打开一个带有Autoexec宏的mdb Call .OpenCurrentDatabase(strMDBPath, False) ' 恢复键盘状态 Call SetKeyboardState(abytCodesSrc(0)) End If ' release Call AttachThreadInput(TIdSrc, TIdDest, False) Call SetForegroundWindow(Application.hWndAccessApp) Call SetFocusAPI(Application.hWndAccessApp) End With Set fGetRefNoAutoexec = objAcc Set objAcc = Nothing
Exit Function ErrHandler: If (TIdDest) Then Call AttachThreadInput(TIdSrc, TIdDest, False) Call SetForegroundWindow(Application.hWndAccessApp) With Err .Raise .Number, .Source, .Description, .HelpFile, .HelpContext End With End Function '********* Code End *********** |