Copy objecten van database1 naar database2

Status
Niet open voor verdere reacties.

AatB

Gebruiker
Lid geworden
15 dec 2007
Berichten
253
Hallo,

ik wil van de ene database tabellen en query's kopiëren (overschrijven moet).
Nu lukt dit wel voor tabellen, maar voor query's krijg ik diverse foutmeldingen

Weet iemand de oplossing?

mvg,

Aat

Code:
Sub AanpassingenDb()
    
    Dim s(20)
    Dim sPath As String
    Dim dPath As String
    
    ' Set the type of the object you want to copy
    ' 0 - Table, 1 - Query
    
    sPath = "C:\Test\Source\db.accdb"
    dPath = "C:\Test\Destination\db.accdb"
    
    x = 0
    s(x) = "tblProvincie": objType = 0: x = x + 1   'Nieuw
    s(x) = "tblLanden": objType = 0: x = x + 1      'Bestaand
    s(x) = "tblMenu": objType = 0: x = x + 1        'Bestaand
    s(x) = "tblTekst": objType = 0: x = x + 1       'Nieuw
    
    s(x) = "VW_Report": objType = 1: x = x + 1      'Bestaand - Foutmelding 2024 - U hebt voor dit object (de tabel) dezelfde naam gebruikt
                                                    'als voor een ander, reeds bestaand object (de query) in de database.

    s(x) = "VW_Report_Jaar": objType = 1: x = x + 1 'Nieuw - Foutmelding 3270 - Kan de eigenschap niet vinden
    s(x) = "S_Gefactureerd": objType = 1: x = x + 1 'Nieuw - Foutmelding 3270 - Kan de eigenschap niet vinden
    s(x) = "S_Offerte": objType = 1: x = x + 1      'Nieuw - Foutmelding 3270 - Kan de eigenschap niet vinden
    
    For i = 0 To x
        If s(i) = "" Then Exit Sub
        objName = s(i)
        Call CopyAccessObject(sPath, dPath, objName, objType)
    Next
  
    Erase s
     
End Sub

Code:
Function CopyAccessObject(srcPath, destPath, objName, objType)
    
    Dim srcDB As Object
    Dim destDB As Object
    
    ' Create the Access.Application objects
    Set srcDB = CreateObject("Access.Application")
    Set destDB = CreateObject("Access.Application")
    
    ' Open the source and destination databases
    srcDB.OpenCurrentDatabase srcPath
    destDB.OpenCurrentDatabase destPath
    
    ' Copy the object from the source to the destination database
    Select Case objType
        Case 0
            srcDB.DoCmd.CopyObject destPath, objName, acTable, objName
        Case 1
            srcDB.DoCmd.CopyObject destPath, objName, acQuery, objName
    End Select
    
    ' Close the databases
    srcDB.CloseCurrentDatabase
    destDB.CloseCurrentDatabase
    
    ' Release the objects
    Set srcDB = Nothing
    Set destDB = Nothing
    
    MsgBox "Object " & objName & " copied successfully!"
End Function
 
Een en ander is opgelost via Transfer ipv CopyProject
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan