locatie database in cel

[Ron321]

Met onderstaande macro haal ik gegevens binnen uit access.
Nu staat de bestandslocatie van de database in de macro zelf maar ik wil de locatie in een cel in excel zetten.
De macro moet dan de locatie uit die cel halen.
Ik weet niet hoe de macro aan te passen.

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Users\test\Documents\Service\historie nieuw (servi" _
        , _
        "ce).mdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
        , _
        "Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk " _
        , _
        "Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OL" _
        , _
        "EDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Comp" _
        , "lex Data=False"), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("huis Gegevens")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "C:\Users\test\Documents\Service\historie nieuw (service).mdb"
        .ListObject.DisplayName = "Tabel_historie_nieuw__service"
        .Refresh BackgroundQuery:=False
    End With
    Sheets("debiteurbeheer").Select
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Users\test\Documents\Service\historie nieuw (servi" _
        , _
        "ce).mdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
        , _
        "Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk " _
        , _
        "Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OL" _
        , _
        "EDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Comp" _
        , "lex Data=False"), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Debiteur Gegevens")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "C:\Users\test\Documents\Service\historie nieuw (service).mdb"
        .ListObject.DisplayName = "Tabel_historie_nieuw__service3"
        .Refresh BackgroundQuery:=False
    End With

 

[Elsendoorn2134]

Ron,

Als je in cel A1 van het eerste tabblad het pad en de naam van de access database opneemt kun
je op de volgende manier hier gebruik van maken.

Dim sAccessDatabase As String

sAccessDatabase = Sheets(1).Range("$A$1")

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;" & _
    "Data Source=" & sAccessDatabase & ";" & _
    "Mode=Share Deny Write;Extended Properties="""";" & _
    "Jet OLEDB:System database="""";" & _
    "Jet OLEDB:Registry Path="""";" & _
    "Jet OLEDB:Database Password="""";" & _
    "Jet OLEDB:Engine Type=5;" & _
    "Jet OLEDB:Database Locking Mode=0;" & _
    "Jet OLEDB:Global Partial Bulk Ops=2;" & _
    "Jet OLEDB:Global Bulk Transactions=1;" & _
    "Jet OLEDB:New Database Password="""";" & _
    "Jet OLEDB:Create System Database=False;" & _
    "Jet OLEDB:Encrypt Database=False;" & _
    "Jet OLEDB:Don't Copy Locale on Compact=False;" & _
    "Jet OLEDB:Compact Without Replica Repair=False;" & _
    "Jet OLEDB:SFP=False;" & _
    "Jet OLEDB:Support Complex Data=False"), Destination:=Range("$A$1")).QueryTable
    
    .CommandType = xlCmdTable
    .CommandText = Array("huis Gegevens")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = sAccessDatabase
    .ListObject.DisplayName = "Tabel_historie_nieuw__service"
    .Refresh BackgroundQuery:=False
End With

Sheets("debiteurbeheer").Select
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;" & _
    "Data Source=" & sAccessDatabase & ";" & _
    "Mode=Share Deny Write;Extended Properties="""";" & _
    "Jet OLEDB:System database="""";" & _
    "Jet OLEDB:Registry Path="""";" & _
    "Jet OLEDB:Database Password="""";" & _
    "Jet OLEDB:Engine Type=5;" & _
    "Jet OLEDB:Database Locking Mode=0;" & _
    "Jet OLEDB:Global Partial Bulk Ops=2;" & _
    "Jet OLEDB:Global Bulk Transactions=1;" & _
    "Jet OLEDB:New Database Password="""";" & _
    "Jet OLEDB:Create System Database=False;" & _
    "Jet OLEDB:Encrypt Database=False;" & _
    "Jet OLEDB:Don't Copy Locale on Compact=False;" & _
    "Jet OLEDB:Compact Without Replica Repair=False;" & _
    "Jet OLEDB:SFP=False;" & _
    "Jet OLEDB:Support Complex Data=False"), Destination:=Range("$A$1")).QueryTable
    
    .CommandType = xlCmdTable
    .CommandText = Array("Debiteur Gegevens")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = sAccessDatabase
    .ListObject.DisplayName = "Tabel_historie_nieuw__service3"
    .Refresh BackgroundQuery:=False
End With

Veel Succes

 

[Ron321]

Dankuwel voor de reactie, ik ga het uitproberen.

 

[Ron321]

Ik krijg de melding:

Fout 13 tijdens uitvoering:
Typen komen niet met elkaar overeen.

Enig idee waardoor dat komt?