auf kennwortgeschützte DB zugreifen

Hallo,
bin leider bei meinen Problem, auf eine kennwortgeschützte Access DB zugreifen zu können, immer noch nicht weiter gekommen. Das scheint wirklich ein Thema für sich zu sein. Dabei soll zum Zugriff das Kennwort aufgehoben und anschließend wieder gesetzt werden.
Jetzt hab ich im Internet noch mal ein paar Seiten gefunden, die evt. weiterhelfen könnten, kann es aber selbst nicht umsetzen. Vielleicht könnt Ihr mir weiterhelfen bzw. ein fertiger Code wäre natürlich Spitze.
Ich arbeite mit Excel und Access 2003.
Hier mal der Codeanfang, wie ich Daten übertrage, soll lt. den Internetseiten auch wichtig sein.
dim ADOC as New ADODB Connection
Dim dbs as new ADODB.Recordset
ADOC.open"Provicer=Microsoft.jet.oledb.4.0;Data source=" &Pfad&"
dbs.open "DB1" ,ADOC, adopenkeyset,adlockoptimistic usw.
hier die Links:
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=1&txtCodeId=6321
http://www.asp101.com/articles/john/connstring/default.asp
Hoffe, Ihr könnt mir weiterhelfen.
Auf jeden Fall schon mal Danke.
Gruß
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
im Beispiel wird eine Passwort-geschützte Access DB gelesen.
Vielleicht hilft dir das weiter.

Option Explicit
'
'   Achtung der Verweis auf: Microsoft ActiveX Data Objects 2.0 Library
'   oder eine höhere Version (2.1, 2.5) muss aktiviert sein.
'
'   Hier soll eine Access-Datenbank, die passwortgeschützt ist gelesen werden.
'
'   Achtung: Die Namen in Access dürfen keinen Bindestrich, sondern immer
'            den Unterstrich als Text-Trennung enthalten - z. B. PSTLZ_Straße.
'
Sub DBZugriff()
Dim Connect    As Connection  ' die Verbindung zu Access
Dim RecSet     As Recordset   ' der Access RecordSet
Dim SQLString  As String      ' der SQL Befehl
Dim Ziel       As Worksheet   ' Excel-Tabellenblatt
Dim Zeile      As Integer     ' Zeile
Dim Spalte     As Integer     ' Spalte
Dim DBPfad     As String      ' Pfad der Access-Anwendung
Dim DBDatei    As String      ' Name der Access-Datei bzw. DB
Dim DBTab      As String      ' Name der Access-Tabelle
Dim Suchbegr   As String      ' String als Suchbegriff
   DBPfad = "C:\Dokumente und Einstellungen\Administrator\Eigene Dateien\Access-DBs\"
   DBDatei = "SHELL-MIS.mdb"
   DBTab = "adressen"
   Set Ziel = Worksheets("Tabelle8")   ' Ziel Tabellenblatt in Excel
'  Die Datenbank öffnen
   Set Connect = New ADODB.Connection
   With Connect  ' für Access 2000 und höhere                     '~~~~~~~~~~~~~~~~
      .Provider = "Microsoft.Jet.OLEDB.4.0" + ";Jet OLEDB:Database Password=welcome"
      .ConnectionString = "Data Source=" & DBPfad & DBDatei       '~~~~~~~~~~~~~~~~
      .Open
   End With
'
'  ******************************************************************************
'  im SQL-String definieren was geholt werden soll => hier verschiedene Varianten
'  ******************************************************************************
'
'    hier alles - die komplette Access-Tabelle
   'SQLString = "SELECT Adressen.* FROM Adressen" ' <-- Hier die Datenbanktabelle
   SQLString = "SELECT " & DBTab & _
                ".* FROM " & DBTab & "" ' <-- Hier die Datenbanktabelle
   If SQLString = "" Then
      MsgBox "hier ist der Wurm drin, der SQLString ist leer - Abbruch.", _
         16, "   der SQLString wurde nicht gefüllt."
      Exit Sub
    Else
      'MsgBox SQLString      ' den SQL-String anzeigen
   End If
   Set RecSet = New ADODB.Recordset
   RecSet.Open SQLString, Connect, adOpenDynamic, adLockReadOnly
   Cells.ClearContents    ' den alten Inhalt löschen
   Call Kopf_entfaerben   ' die alten Kopfzeilen entfernen
   Application.ScreenUpdating = False
'  Die Feldnamen der Datenbanktabelle in die erste Zeile des
'           Excel Ziel-Tabellenblattes schreiben
   For Spalte = 0 To RecSet.Fields.Count - 1
      Ziel.Cells(1, Spalte + 1) = RecSet.Fields.Item(Spalte).Name
   Next Spalte
   Call Kopf_farbig(RecSet.Fields.Count) ' die neuen Kopfzeilen farbig, fett
'  Jetzt alle selektierten Sätze holen und in das Excel-Tabellenblatt schreiben
   Zeile = 1
   If RecSet.EOF = False Then  ' kein EOF => es gibt also Daten !
      RecSet.MoveFirst         ' auf dem ersten Datensatz aufsetzen
    Else
      MsgBox "es konnte nichts selektiert werden => Abbruch.", _
         16, "    fehlerhafte Selektion ?"
      Exit Sub
   End If
   Do While RecSet.EOF = False
      Zeile = Zeile + 1
      For Spalte = 0 To RecSet.Fields.Count - 1
         If IsNull(RecSet.Fields.Item(Spalte).Value) = False Then
            Ziel.Cells(Zeile, Spalte + 1) = RecSet.Fields.Item(Spalte).Value
            Ziel.Rows(Zeile & ":" & Zeile).RowHeight = 13.2
         End If
      Next Spalte
      RecSet.MoveNext
   Loop
   Cells.EntireColumn.AutoFit
   [A1].Select
   Application.ScreenUpdating = True
   RecSet.Close
   Connect.Close
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Beliebteste Forumthreads (12 Monate)

auf kennwortgeschützte DB zugreifen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread