Hyperlink do poszczególnych formularzy w VBA

[Kali]

Witam
Mam pliki firmowe dla poszczególnych lat: 2021.mdb, 2020.mdb, 2019.mdb, 2018.mdb ….)
Chciałem zrobić hyperlink do poszczególnych formularzy w kodzie VB.

Kod:
Application.FollowHyperlink ("C:\Users\User\Documents\2021.mdb")
Działa ale jak dostać się np. do formularza np. Firmy
Nic nie działa:
Application.FollowHyperlink ("C:\Users\User\Documents\2021.mdb\Form\Firmy") czy podobne nie działają.
Umiem to zrobić z poziomu właściwości lecz jak to zrobić przez VB.
Z VB mogę wpisać przez InputBox odpowiedni rok i chcę aby działał link do odpowiedniego formularza np. „Firmy” czy raportu.
Jak mi ktoś może podpowiedzieć polecam się.
SK

[Zbigniew Bratko]

W dniu 20.03.2021 o 06:50, Kali pisze:

Popatrz na przykład http://access.mvps.org/access/forms/frm0034.htm

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

[Kali]

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

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.
Sławek

[Zbigniew Bratko]

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.

[Kali]

Witam
No i udało się działa, choć dochodzę do wniosku, że inaczej chyba powinienem to robić.
Zrobiłem:
Mam w bazie jakiś formularz startowy i stworzyłem (Przycisk136) zamieniłem nazwę na btnOpenForm . Wszedłem w kod Przycisku, wybrałem:
Na górze tam gdzie mam (GENERAL) (Declarations) wkleiłem kod.
Fragment mam następujący na czerwono, czyli z błędem:

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

Inerpretuje to tak, że chyba mam VB z nr 7 a inny wywala.
Pytanie nr1 Tak z ciekawości co oznacza # np. przy if???
Zmieniłem kod
Private Sub btnOpenForm_Click()
fOpenRemoteForm "C:\Users\User\Documents\2021.mdb", "firmy", SW_NORMAL
End Sub
Na fOpenRemoteForm "C:\Users\User\Documents\2021.mdb", "firmy" bo otwierał mi w widoku Projekt.

W planach mam przyciski który przeniesie do formularza (w którym jestem My.name) do wskazanej bazy przez InputBox.

Po przemyśleniu dochodzę do innych wniosków, że kod powinienem chyba wkleić w nowy moduł nazwać go jakoś; OtwForm i zmienić przycisk136 na btnOpenForm. Dochodzę do wniosku, że powinno to działać we wszystkich formularzach i powielenie przycisku btnOpenForm.
Pytanie2 To chyba bardziej lepsze rozwiązanie???

Z ostatniej chwili - przeczytałem post Zbyszka - Bardzo dużo mi pomogłeś i bardzo dziękuję .
SK