🚀 go-pugleaf

W dniu 21.03.2021 o 13:46, Kali pisze:
> Witam
> Ten kod co mi wysłałeś to trochę za trudne jak dla mnie, jeszcze posiedzę ale to nie moja liga, trochę Zbyszek znasz moje możliwości.
> Myślałem, że coś jest prostszego – ścieżka do pliku i wymieniony konkretny formularz.
> Jak wcześniej mnie naprowadziłeś:
> CreateObject("Shell.Application").Open "C:\Users\User\Documents\2021.mdb"  + konkretny formularz np. Firmy
> Lub
> Application.FollowHyperlink ("C:\Users\User\Documents\2021.mdb") + konkretny formularz

Jakby to było takie proste, jak piszesz, to Dev Ashish by nie 
komplikował sprawy.

> 
> Ten kod trochę ponad moje możliwości, prawdopodobnie należy zamienić ten kod user64, a gdzie ściezka??? To za skomplikowane na moje możliwości ale dzięki jeszcze pomyśle.


Wywołanie funkcji jest następujące:

   fOpenRemoteForm "Dysk:\TwójFolder\TwojaBaza.accdb", "TwojFormularz", 
SW_NORMAL



Mój Access 16 w ver. 32-bit przyjął kod bez "zmrużenia  oka". Co prawda 
po wywołaniu występował błąd nr 91, ale dało się to naprawić.

Przetestuj poniższy kod z poziomu formularza:

Option Compare Database
Option Explicit
'************ 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
'

#If VBA7 Then
   Private Declare PtrSafe Function apiSetForegroundWindow Lib "user32" _
               Alias "SetForegroundWindow" _
               (ByVal hwnd As LongPtr) _
               As Long

   Private Declare PtrSafe Function apiShowWindow Lib "user32" _
               Alias "ShowWindow" _
               (ByVal hwnd As Long, _
               ByVal nCmdShow As LongPtr) _
               As Long
#Else
   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
#End If

Private Const SW_MAXIMIZE = 3
Private Const SW_NORMAL = 1

'_______________________________________________
'Otwarcie formularza innej bazy w widoku normalnym
Private Sub btnOpenForm_Click()

   fOpenRemoteForm "c:\tmp\aaa.accdb", "TwojFormularz", SW_NORMAL

End Sub

'___________________________________________
Function fOpenRemoteForm(strMDB As String, _
                         strForm As String, _
                         Optional intView As Variant) _
                         As Boolean
Dim objAccess As Access.Application
Dim lngRet As Long

     On Error GoTo fOpenRemoteForm_Err

     If IsMissing(intView) Then intView = acViewNormal

     If Len(Dir(strMDB)) > 0 Then
         Set objAccess = New Access.Application
         With objAccess
             lngRet = apiSetForegroundWindow(.hWndAccessApp)
             lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)
             'the first call to ShowWindow doesn't seem to do anything
Rem         lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL)

             ' lub okno Accessa zmaksymalizowane
             lngRet = apiShowWindow(.hWndAccessApp, SW_MAXIMIZE)

             .OpenCurrentDatabase strMDB
             .DoCmd.OpenForm strForm, intView

             ' niestety, u mnie warunek Len(.CurrentDb.Name)
             ' powoduje błąd po zamknięciu otwartego Access
             '---------------------------
             'Runtime Error
             '---------------------------
             'Error#: 91

             'Object variable or With block variable not set
             '---------------------------
             'OK
             '---------------------------


Rem            Do While Len(.CurrentDb.Name) > 0
Rem                DoEvents
Rem            Loop

             ' Moja poprawka - przechwycenie błędów m.in. nr 91
             On Error Resume Next
             Do
                 IsObject (.CurrentDb.Name)
                 If Err.Number <> 0 Then
                   Err.Clear
                   Exit Do
                 End If
                 DoEvents
               Loop
             On Error GoTo 0
         End With
     End If

fOpenRemoteForm_Exit:
     On Error Resume Next
     objAccess.Quit
     Set objAccess = Nothing
     Exit Function
fOpenRemoteForm_Err:
     fOpenRemoteForm = False
     Select Case Err.Number
         Case 7866:
             'mdb is already exclusively opened
             MsgBox "The database you specified " & _
             vbCrLf & strMDB & vbCrLf & _
             "is currently open in exclusive mode.  " & vbCrLf _
             & vbCrLf & "Please reopen in shared mode and try again", _
             vbExclamation + vbOKOnly, "Could not open database."
         Case 2102:
             'form doesn't exist
             MsgBox "The Form '" & strForm & _
                   "' doesn't exist in the Database " _
                   & vbCrLf & strMDB, _
                   vbExclamation + vbOKOnly, "Form not found"
         Case 7952:
             'user closed mdb
             fOpenRemoteForm = True
         Case Else:
             MsgBox "Error#: " & Err.Number & vbCrLf & Err.Description, _
                     vbCritical + vbOKOnly, "Runtime error"
     End Select
     Resume fOpenRemoteForm_Exit
End Function
'************ Code End *************

W razie kłopotów pisz co jest nie tak.


-- 
Pozdrawiam
Zbigniew Bratko
accdb.pl
gps.accdb.pl