Avatar billede keldo Nybegynder
12. august 2004 - 13:55 Der er 9 kommentarer og
1 løsning

Backup af database, spørgsmål 527555

Jeg har læst spørgsmål 527555, KAn brugeren lave backup. min kode er:

Private Sub Kommandoknap108_Click()

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20
Private Const FOF_CREATEPROGRESSDLG As Long = &H0
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200

Private Declare Function apiSHFileOperation Lib "Shell32.dll" _
            Alias "SHFileOperationA" _
            (lpFileOp As SHFILEOPSTRUCT) _
            As Long

Function fMakeBackup() As Boolean
Dim strMsg As String
Dim tshFileOp As SHFILEOPSTRUCT
Dim lngRet As Long
Dim strSaveFile As String
Dim lngFlags As Long
Const cERR_USER_CANCEL = vbObjectError + 1
Const cERR_DB_EXCLUSIVE = vbObjectError + 2
    On Local Error GoTo fMakeBackup_Err

    If fDBExclusive = True Then Err.Raise cERR_DB_EXCLUSIVE
   
    strMsg = "Are you sure that you want to make a copy of the database?"
    If MsgBox(strMsg, vbQuestion + vbYesNo, "Please confirm") = vbNo Then _
            Err.Raise cERR_USER_CANCEL
           
    lngFlags = FOF_SIMPLEPROGRESS Or _
                            FOF_FILESONLY Or _
                            FOF_RENAMEONCOLLISION
    strSaveFile = CurrentDb.Name
    With tshFileOp
        .wFunc = FO_COPY
        .hwnd = hWndAccessApp
        .pFrom = CurrentDb.Name & vbNullChar
        .pTo = strSaveFile & vbNullChar
        .fFlags = lngFlags
    End With
    lngRet = apiSHFileOperation(tshFileOp)
    fMakeBackup = (lngRet = 0)
   
fMakeBackup_End:
    Exit Function
fMakeBackup_Err:
    fMakeBackup = False
    Select Case Err.Number
        Case cERR_USER_CANCEL:
            'do nothing
        Case cERR_DB_EXCLUSIVE:
            MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _
                    vbCrLf & "is opened exclusively.  Please reopen in shared mode" & _
                    " and try again.", vbCritical + vbOKOnly, "Database copy failed"
        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fMakeBackup" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg, vbInformation, "fMakeBackup"
    End Select
    Resume fMakeBackup_End
End Function

Private Function fCurrentDBDir() As String
'code courtesy of
'Terry Kreft
Dim strDBPath As String
Dim strDBFile As String
      strDBPath = CurrentDb.Name
      strDBFile = Dir(strDBPath)
      fCurrentDBDir = Left(strDBPath, InStr(strDBPath, strDBFile) - 1)
End Function

Function fDBExclusive() As Integer
Dim db As Database
Dim hFile As Integer
    hFile = FreeFile
    Set db = CurrentDb
    On Error Resume Next
    Open db.Name For Binary Access Read Write Shared As hFile
    Select Case Err
        Case 0
            fDBExclusive = False
        Case 70
            fDBExclusive = True
        Case Else
            fDBExclusive = Err
    End Select
    Close hFile
    On Error GoTo 0
End Function


Men jeg får samme fejl til at starte med som i ovennævnte spørgsmål, nemlig:

Udtrykket vedklik, du indtastede som idstilling af hændelsesegenskaberne, gav en fejl: Only commments may appear  after End Sub, End Function or End Property.

Jeg kan bare ikke se at der er et End Sub eller lign ofr meget. Er der nogen der kan hjælpe?
Avatar billede nih Novice
12. august 2004 - 14:59 #1
den øverste linje skal slettes: Private Sub Kommandoknap108_Click()
Avatar billede nih Novice
12. august 2004 - 15:01 #2
herefter skal du nok lave en ny hændelses procedure til din knap - længere nede i modulet
Avatar billede keldo Nybegynder
12. august 2004 - 15:05 #3
Øhhh, hvor skal jeg lave den hændelsesprocedure?? Jeg mener hvor i modulet?? Jeg troede den skulle stå i starten af modulet.

Jeg har ivørigt brugt kodan fra:
http://www.mvps.org/access/api/api0026.htm
Avatar billede hekla Nybegynder
12. august 2004 - 17:21 #4
Fjern den øverste linie (Private Sub Kommandoknap108_Click()), sæt koden ind i et modul og kald funktionen fra din kommandoknap vha:
call fMakeBackup

Hus reference til DAO
Avatar billede keldo Nybegynder
12. august 2004 - 17:28 #5
Hekla...ok lyder interessent. Koden er i et modul, skal jeg så i et modul "VedKlik" skrive:

Private Sub Kommandoknap110_Click()

call fMakeBackup

End SUB

???
Avatar billede hekla Nybegynder
12. august 2004 - 17:43 #6
Ja og nej! Hele forløbet er:
Opret et nyt modul og indsæt koden minus den første linie.
Højreklik på din kommandoknap og vælg "Generer hændelsesprocedure..."
Vælg Kodegenerator
Skriv call fMakebackup, der hvor cursoren står.
Avatar billede keldo Nybegynder
13. august 2004 - 10:39 #7
Fantastisk, nu virker det. tak for hjælpen
Avatar billede keldo Nybegynder
13. august 2004 - 10:47 #8
hmm, ok det virker hvis databasen ligger på lokal pc. Men hvad nu når den ligger på en server? Så kommer den med: Compile error: User defined type not defined.. og markerer de første 2 linier i:

Function fDBExclusive() As Integer
Dim db As Database
Dim hFile As Integer
    hFile = FreeFile
    Set db = CurrentDb
    On Error Resume Next
    Open db.Name For Binary Access Read Write Shared As hFile
    Select Case Err
        Case 0
            fDBExclusive = False
        Case 70
            fDBExclusive = True
        Case Else
            fDBExclusive = Err
    End Select
    Close hFile
    On Error GoTo 0
End Function
Avatar billede nih Novice
13. august 2004 - 10:53 #9
I VBA editoren skal du have reference til DAO:

tools - references - hak i Microsoft dao 3.XX
Avatar billede keldo Nybegynder
13. august 2004 - 10:59 #10
Ja selvfølgelig... Jeg havde lavet testen i en kopi. Org. havde jeg glemt at markerer DAO. Tak for hjælpen
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Dyk ned i databasernes verden på et af vores praksisnære Access-kurser

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester