Office: VBA - automatische Aktualisierung aus Datenbank

Hi ihr!
Ich hab ein großes Problem, auf dessen Lösung ich selbst nach mehreren Tagen Probieren nicht komme. Ich hoffe echt, ihr könnt mir helfen!

Ich will euch die Situation erklären.

Ich habe eine Datenbank erstellt. Diese Datenbank enthält eine Datentabelle, die ich auswerten soll. Die Auswertung selbst soll aber nicht über Berichte sondern über Excel erfolgen.

Ich habe jetzt in Excel eine Befehlsschaltfläche eingefügt, die mir die Daten aus der Datenbank aktualisiert. Das Problem dabei war, dass der Ordner mit der Datenbank und der Excelauswertung später wahrscheinlich in einen anderen Ordner verschoben wird, sodass ich nicht mit konkreten Bezügen arbeiten konnte.

Dazu hab ich ein Makro erstellt, welches mir zuerst den Pfad der Exceltabelle ausliest und anschließend den Namen der Datenbank hinten dranschreibt.

Code:

Dim DBPfad, ExcelPfad As String 
ExcelPfad = ActiveWorkbook.Path 
DBPfad = ExcelPfad & "\DB_Einnaessen_im_Vorschulalter.mdb" 

Diesen Pfad habe ich dann als Source der Datenbank eingebaut.
Das vollständige Makro sieht folgendermaßen aus (einen Teil davon hab ich mit dem Makro-Recorder aufgenommen..kann also sein, dass unsinniges im Code dabei ist ^^")

Code:

Sub makr_daten_aus_DB_einlesen() 

Dim DBPfad, ExcelPfad As String 
ExcelPfad = ActiveWorkbook.Path 
DBPfad = ExcelPfad & "\DB_Einnaessen_im_Vorschulalter.mdb" 
' 
' 
    Sheets("TAB_daten_fragebogen").Select 
    Range("A1:AL65536").ClearContents 
    Range("A1").Select 
    With ActiveSheet.QueryTables.Add(Connection:=Array( _ 
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=DBPfad ;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Regist" _ 
        , _ 
        "ry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bul" _ 
        , _ 
        "k 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:SF" _ 
        , "P=False"), Destination:=Range("A1")) 
        .CommandType = xlCmdTable 
        .CommandText = Array("TAB_daten_fragebogen") 
        .Name = "DB_Einnaessen_im_Vorschulalter" 
        .FieldNames = True 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .BackgroundQuery = True 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = True 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .PreserveColumnInfo = True 
        .SourceDataFile = DBPfad 
        .Refresh BackgroundQuery:=False 
    End With 
    Sheets("Menü").Select 
End Sub 

Jetzt zu meinem Problem. An sich funktioniert das schon so, wie ich mir das gedacht hatte, ABER: Wenn ich auf den Button klicke, kommt die Meldung:
Die Datei 'Pfad\Fragebogen_Einnaessen_im_Vorschulalter\DB_Einnaessen_im_Vorschulalter.mdb' wurde nicht gefunden. Wollen Sie stattdessen zu Pfad\Fragebogen_Einnaessen_im_Vorschulalter\DB_Einnaessen_im_Vorschulalter.mdb verbinden?
Und ich versteh absolut nicht, warum Wenn ich da auf ok klicke, funktioniert alles einwandfrei. Es muss also irgendwie an den ' ' liegen, die ich ja aber nirgendwo im Code stehen habe. Kann man da irgendwas machen? (

Ist wirklich dringend...bitte helft mir..wenn ihr noch mehr Informationen braucht, dann sagt einfach was :/

 

Hi gflamme...

um mit den " nicht durcheinander zu kommen, würde ich empfehlen zur
Aufnahme der einzelnen Strings eigene Variablen zu verwenden. Ist
etwas unübersichtlich. Möglicherweise liegt der Fehler hier...

Code:

"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=""""; User ID=Admin;Data Source=DBPfad ;Mode=Share Deny Write;Extended

Da ist DBPfad als String selbst und nicht als Inhalt eingetragen, versuche
mal...

Code:

OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=""""; User ID=Admin;Data Source=" & DBPfad & " ;Mode=Share Deny Write;Extended

Ausprobiert und getestet habe ich es nicht.

Gruß

 

Das hilft nicht weiter, denn damit kommt es nur zu einem Laufzeitfehler 13. Die Typen sind unverträglich.


Wenn man das Problem nicht lösen kann, kann man es vielleicht umgehen?

Heißt: könnte man statt einer Office-Verknüpfung auch irgendwie anders die Daten aus der DB auslesen und anschließend in die Excel-Tabelle einfügen?

 

hm...ich bzw. eigentlich mein Freund hat jetzt ne Lösung gefunden.

Wen's interessiert:

Code:

Public Sub Daten_Import()
Dim DBPfad As String
Dim Tabellenname As String
Dim Anzahl_Felder, i, x, z, Anzahl, s As Integer
Dim n As Variant

DBPfad = ActiveWorkbook.Path & "\DB_Einnaessen_im_Vorschulalter.mdb"
Tabellenname = "TAB_daten_fragebogen"
    Sheets("TAB_daten_fragebogen").Select
    Range("A1:AL65536").ClearContents
    Range("A1").Select
Dim ws As Workspace
Set ws = DBEngine.Workspaces(0)

    Dim Datenbank As Database
    'Datenbank öffnen
    Set Datenbank = OpenDatabase(DBPfad)
    
        'Überschriften setzen (Feldnamen)
        Anzahl_Felder = 0
        For i = 0 To Datenbank.TableDefs(Tabellenname).Fields.Count - 1
                Anzahl_Felder = Anzahl_Felder + 1
                Cells(1, Anzahl_Felder) = Datenbank.TableDefs(Tabellenname).Fields(i).Name
                With Cells(1, Anzahl_Felder)
                    .Interior.ColorIndex = 48
                    .Interior.Pattern = xlSolid
                    .Font.Bold = True
                End With
        Next i
  
    
    'Tabelle zum Einlesen öffnen
Dim Datensatz As Recordset
    
    Set Datensatz = Datenbank.OpenRecordset(Tabellenname, dbOpenDynaset)
    'Anzahl der Datensätze
    Anzahl = Datenbank.TableDefs(Tabellenname).RecordCount
    z = 2 'ab Zeile 2 Daten schreiben
    'alle Datensätze einlesen
    Do Until Datensatz.EOF
        'Schleife über alle Felder
        'ab Spalte 1 wird geschrieben
            s = 1
            For x = 0 To Datenbank.TableDefs(Tabellenname).Fields.Count - 1
                    'Wert ermitteln
                    n = Datensatz.Fields(x).Value
                    'Ausgabe in der Tabelle
                    Cells(z, s) = n
                    'Spaltennummer um 1 erhöhen
                    s = s + 1
            Next x
        'Ausgabezeile um 1 erhöhen
        z = z + 1
        'nächster Datensatz
        Datensatz.MoveNext
    Loop
    'Datenbank schließen
    Datenbank.Close
    'Optimale Spaltenbreite
    Range(Cells(1, 1), Cells(1, Anzahl_Felder)).EntireColumn.AutoFit
    'Information (Anzahl der Datensätze)

    Sheets("Menü").Select
    
Set Datenbank = Nothing
Set Datensatz = Nothing
    
End Sub

Erklären kann ich das allerdings alles nicht ^^