AW: Accessabfrage in Excel bearbeiten
23.07.2021 10:35:12
Daniel
Ich habe jetzt diesen Code Gefunden:
und hier habe ich eine Beispieldatei:
https://www.herber.de/bbs/user/147272.xlsm
Wäre echt cool wenn mir da jemand helfen könnte.
LG
Daniel
Private Sub CommandButton9_Click()
Dim ADOC As New ADODB.Connection
Dim dbs As New ADODB.Recordset
Dim sPfad As String
Dim rBereich As Range, LRow As Long
With Sheets("Tabelle16")
Set rBereich = .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 21)
Sheets("Dummy").Range(rBereich.Address).FormulaR1C1 = _
"=IF(CONCATENATE(RC1,RC2,RC3,RC4,RC5,RC6,RC7,RC8,RC9,RC10)" & _
"CONCATENATE(Mitglieder!RC1,Mitglieder!RC2,Mitglieder!RC3,Mitglieder!RC4,Mitglieder!RC5,Mitglieder!RC6,Mitglieder!RC7,Mitglieder!RC8,Mitglieder!RC9,Mitglieder!RC10),1,"""")"
sPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
ADOC.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPfad & "Mitglieder.mdb;"
dbs.Open "tblMitglieder", ADOC, adOpenKeyset, adLockOptimistic
Sheets("Mitglieder").Activate
LRow = 2
Do Until .Cells(LRow, 1).Value = ""
If Sheets("Dummy").Cells(LRow, 21) = 1 Then
dbs.AddNew
dbs!Garten_Nr = .Cells(LRow, 1).Value
dbs!Anrede = .Cells(LRow, 2).Value
dbs!Vorname = .Cells(LRow, 3).Value
dbs!Nachname = .Cells(LRow, 4).Value
dbs!Strasse = .Cells(LRow, 5).Value
dbs!Ort = .Cells(LRow, 6).Value
dbs!Telefon = .Cells(LRow, 7).Value
dbs!Geboren = .Cells(LRow, 8).Value
dbs!Eintritt = .Cells(LRow, 9).Value
dbs!Mitgl_Jahre = .Cells(LRow, 10).Value
dbs.Update
End If
LRow = LRow + 1
Loop
dbs.Close
ADOC.Close
Set ADOC = Nothing
Set dbs = Nothing
Sheets("Dummy").UsedRange.Value = ""
Set rBereich = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Offset(0, 9))
Sheets("Dummy").Range(rBereich.Address).Value = rBereich.Value
End With
Exit Sub
fehler:
Sheets("Dummy").Columns(11).Value = ""
MsgBox "Es trat ein Fehler auf!"
dbs.Close
ADOC.Close
Set ADOC = Nothing
Set dbs = Nothing
End Sub