🚀 go-pugleaf

W dniu poniedziałek, 20 lutego 2017 19:46:39 UTC+1 użytkownik Jan Koc napisał:
> Witam. Proszę o pomoc .
> Usiłuję zastosować rozwiązanie Krzysztofa Pozorka do aktualizacji frontonu bazy.
> Baza oryginalna = = "X:\....\13p.accdb"
> W folderze klienta, gdzieś w sieci , znajduje się kopia nieaktualna …..\13p.accbd oraz baza = „…..\KopiarkaNowa.accdb”.  Przy zamknięciu bazy „13p”, po sprawdzeniu, że jest nieaktualna, następuje otwarcie bazy KopiarkaNowa, która ładnie kopiuje nową wersję. Wszystko zgodnie z projektem KP, zmiana to zamiast skryptu normalna baza ACCBD.
> I to rozwiązanie postanowiłem poprawić. Chcę zlikwidować bazę „KopiarkaNowa” u klienta i importować ją wtedy gdy będzie potrzebna z folderu „X:\...\KopiarkaNowa.accdb. Przy pierwszym wywołaniu bazy „13p” u klienta KopiarkaNowa.accdb byłaby wycinana. W ten sposób nie musiałbym osadać KopiarkiNowej u klientów, w różnych folderach, szukać gdzie mi ją przenieśli, tłumaczyć po co jest itd.
> I tu coś nie działa.
> Po skopiowaniu (VB) KopiarkaNowa.accdb, przy próbie otwarcia otrzymuję komunikat, że „KopiarkaNowa” to nierozpoznany format bazy
> Z góry dziękuję za pomoc i przepraszam, że tak rozwlekle, ale ostatnim razem trzy tygodnie korespondowałem na grupie i dopiero gdy wszystko wyłożyłem kawa na ławę, to okazało się, że zmiana jednego ustawienia (usunięcie apostrofa ze specyfikacji exportu) załatwiała sprawę. 
> 
> Private Sub Form_Unload(Cancel As Integer)
> On Error Resume Next
> Dim objAcc As Access.Application
> Dim NewVer As Long, OldVer As Long, NewDb As Object
> Dim NewPath As String   'ścieżka do nowej wersji bazy na sieci
> Dim OldPath As String   'ścieżka do starego pliku bazy
>         'zamykamy, sprawdzając, czy nie ma nowej wersji programu
>         NewPath = "X:\...\13p.accdb"
>               Set NewDb = DBEngine.OpenDatabase(NewPath)
>             NewVer = NewDb.Containers("Databases").Documents("UserDefined").Properties("WersjaProg")
>             NewDb.Close
>         Set NewDb = Nothing
>         OldVer = DBEngine.Workspaces(0)(0).Containers("Databases").Documents("UserDefined").Properties("WersjaProg")
>         If Err <> 0 Then
>             MsgBox "Wystąpł błąd”
>         ElseIf OldVer >= NewVer Then
>             'Ok, baza jest w aktualnej wersji
>         Else
> ‘Kopiuję bazę „KopiarkaNowa” jeśli nie istnieje
>        Dim strSciezkaPliku As String
> strSciezkaPliku = CurrentProject.Path & "\KopiarkaNowa.accdb"
> Dim fs
> Set fs = CreateObject("Scripting.FileSystemObject")
>   If fs.FileExists(strSciezkaPliku) Then
> ‘ I tu ładnie kopiuje bazę “13p”
>                 Set objAcc = New Access.Application
>              objAcc.OpenCurrentDatabase CurrentProject.Path & "\KopiarkaNowa.accdb", True
>              objAcc.DoCmd.OpenForm "startowy", , , , , acHidden
>              objAcc.Forms!startowy.Form.TimerInterval = 1000 'tchnięcie życia w wywołany formularz
> Else
>        'skopiujemy bazzę KopiarkaNowa do aktualnego katalogu
>          Dim CurDB As String, KopiaDB As String, LenDB As Long, Plik As String, NrPliku As Long
>    DoCmd.Hourglass -1
>     CurDB = "X:\.....\KopiarkaNowa.accdb"
>     Err = 0
>     Plik = Space(FileLen(CurDB))
>     NrPliku = FreeFile
>     Open CurDB For Binary Access Read Shared As #NrPliku
>         Get #NrPliku, 1, Plik
>     Close #NrPliku
>     If Err = 52 Then
>         MsgBox "Brak dostępu do pliku 
>     ElseIf Err Then
>         MsgBox Err.Description
>     Else  
>        KopiaDB = CurrentProject.Path & "\KopiarkaNowa.accdb"
>     
>         If KopiaDB & "" <> "" Then
>                Kill KopiaDB
>              Err = 0
>            Plik = Space(FileLen(CurDB))
>             NrPliku = FreeFile
>             Open KopiaDB For Binary Access Write Shared As #NrPliku
>                 Put #NrPliku, 1, Plik
>             Close #NrPliku
>             If Err = 0 Then
>             Else
>                 MsgBox Err.Description
>             End If
>         End If 
>     DoCmd.Hourglass 0             
>         End If       
>         On Error GoTo rrr
>                     Set objAcc = New Access.Application
>              objAcc.OpenCurrentDatabase CurrentProject.Path & "\KopiarkaNowa.accdb", True
>              ‘ i tu wyskakuje komunikat o nierozpoznanym formacie bazy
>              objAcc.DoCmd.OpenForm "startowy", , , , , acHidden
>                 'otwieramy formularz w zewnętrznej bazie, który przejmie sterowanie nad dalszym przebiegiem operacji.
>              objAcc.Forms!startowy.Form.TimerInterval = 1000 'tchnięcie życia w wywołany formularz
>      End If
>     End If
> rrr_Exit:
>      Application.Quit
>     Exit Sub
> rrr::
>     MsgBox Error$
>     MsgBox "Skontaktuj się z administratorem  +48 694 00 55 45."
>     Resume rrr_Exit     
> End Sub


http://www.access24.pl

Witam
zaproponuję trochę inne rozwiązanie

Założenia:
    Wersja pliku wzorca ma nazwę app.mdb
    Umieszczona jest na udziale sieciowym: \\serwer\aplikacje\app\
    Każdy użytkownik ma prawo dodawania i zmiany plików w tym udziale

Ręcznie dla użytkownika to by było tak:
    Sprawdź czy na udziale sieciowym nie ma nowej aktualizacji
    Jak jest to ja przegraj i uruchom

Odnośnie punktu sprawdzenia to dobrym sposobem jest stworzenie pliku tekstowego złożoną z pary: nazwa komputera + uzytkownik, jezeli takiego pliku nie ma to podmieniamy, jezeli jest to uruchamiamy to co mamy na stacji, to dobrze zrealizuje ten skrypt:

@echo off
CLS
set masterFile=app.mdb
set shareMaster=\\serwer\aplikacje\app\
set destFolder=%AppData%\AppName\
set mark=%computername%_%username%
echo %destFolder%

IF not EXIST %sharemaster%%mark%.txt GOTO AKTUALIZACJA
GOTO URUCHOMIENIE

:AKTUALIZACJA
ECHO Program wymaga aktualizacji...
IF not EXIST %destFolder% MKDIR %destFolder%
COPY %sharemaster%%masterFile% %destFolder%%masterFile% /Y
ECHO %sharemaster%%mark% > %sharemaster%%mark%.txt


:URUCHOMIENIE
echo Uruchamianie aplikacji..
c:
cd "\Program Files\Microsoft Office\OFFICE11\"
start MSACCESS.EXE  %destFolder%%masterFile%

ja stosuję to rozwiązanie, co najważniejsze działa:)
rozwiązanie problemu pochodzi z http://ziembor.pl/plitproblogs/category/access/