none
Verbindungsstring ADO von Exel 2010 zu Access 2010 mit Datenbankkennwort

    Frage

  • Hallo ich habe in Excel 2010 eine SQL Abfrage zu eine Access Datenbank mit Datenbankkennwort. Leider kommt immer der Fehler:

    Fehler Code:-2147217843 - Fehlerbeschreibung:Die Anwendung kann nicht gestartet werden. Die Informationsdatei für die Arbeitsgruppe fehlt oder ist exklusiv von einem anderen Benutzer geöffnet.


    '
    'Werte aus Datenbank suchen
    Option Explicit
    Public Sub ZugriffReklaGruende()
    On Error GoTo FehlerSQL
    Sheets("Produktblatt").Select
        Dim Pfad As String, CO As Object, SQL As String
        Dim rs As Object, i As Long, arr As Variant
        Dim S As String
        
        Pfad = "\\dcdep89861002\SRV_SHARE\MeinMIS\System\DWH\"
        If Right(Pfad, 1) <> "\" Then Pfad = Pfad & Application.PathSeparator
        
        If Dir(Pfad & "Reklamationen.accdb") = "" Then
            MsgBox "Datenbank wurde nicht gefunden!", , "Mitteilung"
            Exit Sub
        End If
        
        Set CO = CreateObject("ADODB.Connection")
        Dim Benutzer
        With CO
            .CursorLocation = 3 'entspricht "adUseClient"
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Properties("User ID") = "admin"
            .Properties("Password") = "testkennwort"
            .Properties("Extended Properties") = ""
            .Properties("Persist Security Info") = "True"
           ' .Properties("Mode") = "Read"
           ' .Properties("Database Locking") = "1"
            .Properties("Data Source") = Pfad & "Reklamationen2.accdb"
            .Open
        End With
        
        SQL = "SELECT * FROM Grund "
        Benutzer = Environ("Username")
        S = Range("NameMA").Text: S = Replace(S, "*", "%")
        SQL = SQL '& "WHERE Perso_ID LIKE('" & s & "') "
        Set rs = RecordsetOeffnen(CO, SQL)
        
        For i = 0 To rs.Fields.Count - 1
            Range("D1").Offset(0, i).Value = rs.Fields(i).Name
        Next i
        
        Range("D2:D6000").ClearContents
        If (rs.EOF) Then MsgBox "Kein Datensatz gefunden", , "Mittelung": GoTo ENDE
        arr = rs.GetRows
        Range("D2").Resize(UBound(arr, 2) + 1, UBound(arr, 1) + 1).Value = _
            ArrayTransponieren(arr)
        
    ENDE:
    rs.Close
    CO.Close
    Set rs = Nothing: Set CO = Nothing
    Exit Sub
    FehlerSQL:
    MsgBox (err.Number & " " & err.Description)
    End Sub
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    'Recordset öffnen
    Public Function RecordsetOeffnen(ByVal CO As Object, ByVal SQL As String) As Object
        On Error GoTo Fehler
        Set RecordsetOeffnen = CreateObject("ADODB.Recordset")
        With RecordsetOeffnen
            .CursorLocation = 3   '3=adUseClient
            .Open SQL, CO, 2, 3   '2=adOpenDynamic, 3=adLockOptimistic
        End With
    Exit Function
    Fehler:
    MsgBox "Fehler Nr: " & err.Number & vbCr & vbCr & _
           err.Description, , "Fehler"
    End Function
    'Daten verändern
    Public Function SqlAusführen(ByVal CO As Object, ByVal SQL As String) As Boolean
        On Error GoTo Fehler
        SqlAusführen = False
        With CreateObject("ADODB.Recordset")
            .CursorLocation = 3   '3=adUseClient
            .Open SQL, CO, 2, 3   '2=adOpenDynamic, 3=adLockOptimistic
        End With
        SqlAusführen = True
    Exit Function
    Fehler:
    MsgBox "Fehler Nr: " & err.Number & vbCr & vbCr & _
           err.Description, , "Fehler"
    End Function
    'Array drehen(transponieren)
    Public Function ArrayTransponieren(ByVal arr As Variant) As Variant
        Dim vDaten As Variant
        Dim lIndex1 As Long, lIndex2 As Long
        ReDim vDaten(LBound(arr, 2) To UBound(arr, 2), LBound(arr, 1) To UBound(arr, 1))
        For lIndex1 = LBound(arr, 1) To UBound(arr, 1)
            For lIndex2 = LBound(arr, 2) To UBound(arr, 2)
                vDaten(lIndex2, lIndex1) = arr(lIndex1, lIndex2)
            Next lIndex2
        Next lIndex1
        ArrayTransponieren = vDaten
    End Function



    Donnerstag, 26. April 2012 15:01

Antworten

Alle Antworten

  • Hallo!

    Ist das Backend mit der Access-Sicherheit per mdw gesichert (lt. Codebeispiel) oder hat es ein Datenbankkennwort lt. Beitragstext?

    Ein Datenbankpasswort kannst du folgendermaßen einstellen:

    .Properties("Jet OLEDB:Database Password") = "testkennwort"


    Die Zeile

    .Properties("Password") = "testkennwort"

    darfst du nur dann verwenden, wenn der Admin in der aktiven mdw dieses Kennwort hat.

    mfg
    Josef


    Code-Bibliothek für Access-Entwickler
    AccUnit - Testen von Access-Anwendungen
    Virtueller Access-Stammtisch

    Freitag, 27. April 2012 06:36
  • HPLAp wrote:

    Fehler Code:-2147217843 - Fehlerbeschreibung:Die Anwendung kann nicht
    gestartet werden. Die Informationsdatei für die Arbeitsgruppe fehlt oder
    ist exklusiv von einem anderen Benutzer geöffnet.

    Wie es aussieht müsstest Du eine bestimmte Arbeitsgruppendatei auswählen, damit Du an die MDB rankommst. Falls auf dem Rechner Access nicht installiert ist, kann es sein, dass die System.MDW nicht angelegt oder mit Jet verbunden ist.

    Ich selber würde DAO den Vorzug geben. Aber das sollte aber auch mit dem OLEDB Provider gehen, indem Du dort das Property("Jet OLEDB:System Database") entsprechend auf die Arbeitsgruppen Datei verweisen lässt.

    Details siehe hier:
    http://msdn.microsoft.com/en-us/library/aa141495(v=office.10).aspx

    Gruss
    Henry

    Freitag, 27. April 2012 06:37