🚀 go-pugleaf

W dniu 20.03.2021 o 06:50, Kali pisze:
> 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
> 

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

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

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

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

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