🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: pl.comp.bazy-danych.msaccess
Article #137419

Aktualizacja frontonu

#137419
From: Jan Koc
Date: Mon, 20 Feb 2017 18:46
88 lines
5786 bytes
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
Technical Details
Message-ID: <7f2d2dab-7fa4-4540-910b-a59d66b3b231@googlegroups.com>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.icm.edu.pl!newsfeed.pionier.net.pl!news.glorb.com!e137no1829959itc.0!news-out.google.com!78ni2365itm.0!nntp.google.com!e137no1838693itc.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail

Show Full Headers
Complete Article Headers
X-Received: by 10.99.36.131 with SMTP id k125mr7922735pgk.25.1487616398840;        Mon, 20 Feb 2017 10:46:38 -0800 (PST)
X-Received: by 10.157.56.117 with SMTP id r50mr1494868otd.12.1487616398792; Mon, 20 Feb 2017 10:46:38 -0800 (PST)
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.icm.edu.pl!newsfeed.pionier.net.pl!news.glorb.com!e137no1829959itc.0!news-out.google.com!78ni2365itm.0!nntp.google.com!e137no1838693itc.0!postnews.google.com!glegroupsg2000goo.googlegroups.com!not-for-mail
Newsgroups: pl.comp.bazy-danych.msaccess
Date: Mon, 20 Feb 2017 10:46:38 -0800 (PST)
Complaints-To: groups-abuse@google.com
Injection-Info: glegroupsg2000goo.googlegroups.com; posting-host=83.7.245.154; posting-account=PWJ4IAoAAAAF14TuSAASrVsGQI86DsCf
NNTP-Posting-Host: 83.7.245.154
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <7f2d2dab-7fa4-4540-910b-a59d66b3b231@googlegroups.com>
Subject: Aktualizacja frontonu
From: Jan Koc <jan.kociumbas@gmail.com>
Injection-Date: Mon, 20 Feb 2017 18:46:38 +0000
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit