Mając jeszcze dostęp do programu Access wykonałem test połączenia VBA pomiędzy Excelem, a bazą danych Access .accdb. Obecnie niestety nie dysponuję licencją programu Access, także nie jestem w stanie sprawdzić poprawności kodu
UWAGA! Nie mam możliwości weryfikacji kodu, czy jest poprawny. Brak dostępu do programu Access.
Baza danych jest w tym samym folderze co plik Excela .xlsm co potwierdza użyty kod ThisWorkbook.Path (bazę danych trzeba utworzyć samemu). W tym poście archiwizuje jak stworzyć tablę, jak dodać rekordy, jak zaznaczyć rekordy i jak zaktualizować rekordy w tabeli bazy danych Access .accdb.
Ta stronka bardzo mi pomogła: stackoverflow.com.
Tworzenie tabeli w bazie danych Access .accdb za pomocą kodu VBA Excel:
(zastanawia mnie tylko fakt, że brak jest hasła do bazy danych – a hasło jest na pewno)
' https://stackoverflow.com/questions/30081993/ms-excel-to-ms-access-accdb-database-from-vba-sql-syntax-error Sub Create_Table() '!!!!!! Add Reference to Microsoft ActiveX Data Objects 2.x Library !!!!!! Dim strConnectString As String Dim objConnection As ADODB.Connection Dim strDbPath As String Dim strTblName As String Dim wCL As Worksheet Dim wCD As Worksheet Set wCL = Worksheets("Sheet1") ' Set wCD = Worksheets("Contract Data") 'Set database name and DB connection string-------- strDbPath = ThisWorkbook.Path & "\TestDB.accdb" '================================================== ' strTblName = wCL.Range("TableName").Value 'strTblName = ActiveSheet.Range(Cells(1, 1), Cells(2, 3))("TestTable").Value strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";" 'Connect Database; insert a new table Set objConnection = New ADODB.Connection On Error Resume Next With objConnection .Open strConnectString .Execute "CREATE TABLE " & "TEST2" & " (" & _ "Imie text(20), " & _ "Nazwisko text(30)," & _ "Lat int)" End With Set objConnection = Nothing End Sub
Dodawanie rekordów za pomocą VBA Excel do utworzonej bazy danych Access .accdb:
Sub INSERT_to_Table() '!!!!!! Add Reference to Microsoft ActiveX Data Objects 2.x Library!!!!!! Dim strConnectString As String Dim objConnection As ADODB.Connection Dim strDbPath As String Dim strTblName As String Dim strSQL As String Dim ErrorMessage 'Set database name and DB connection string-------- strDbPath = ThisWorkbook.Path & "\TestDB.accdb" '================================================== strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.Path & "\TestDB.accdb;" & _ "Jet OLEDB:Database Password='****';" '& _ ' "Mode=Share Exclusive" ' strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & _ ' ";MS Access;PWD=asdf" 'Connect Database; insert a new table Set objConnection = New ADODB.Connection On Error GoTo ErrorMessage With objConnection .Open strConnectString .Execute "INSERT INTO TEST" & _ " (Imie,Nazwisko,Lat)" & _ " VALUES ('Adam','Nowak',12)" End With Set objConnection = Nothing Exit Sub ErrorMessage: MsgBox "OPIS: " & Err.Description & Chr(10) & _ "NUMER: " & Err.Number Set objConnection = Nothing End Sub
Zaznaczanie rekordów z bazy danych:
(ale brak wklejenia danych do arkusza?)
Sub Select_Table_Records() 'Add Reference to Microsoft ActiveX Data Objects 2.x Library Dim strConnectString As String Dim objConnection As ADODB.Connection Dim strDbPath As String Dim strTblName As String Dim strSQL As String 'Set database name and DB connection string-------- strDbPath = ThisWorkbook.Path & "\TestDB.accdb" '================================================== strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";" 'Connect Database; select records Set objConnection = New ADODB.Connection On Error Resume Next With objConnection .Open strConnectString .Execute "SELECT * FROM TEST" End With Set objConnection = Nothing End Sub
Znalazłem też w swoich testowych plikach taki kod zaznaczenia danych (tu akurat jest wklejanie danych do arkusza):
' https://stackoverflow.com/questions/9083232/writing-excel-vba-to-receive-data-from-access Private Sub Workbook_Open() Dim cn As Object, rs As Object Dim intColIndex As Integer Dim DBFullName As String Dim TargetRange As Range On Error GoTo Whoa Set TargetRange = ActiveSheet.Range("A1") Set cn = CreateObject("ADODB.Connection") cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=T:\Tablica\TestMDB.mdb;" & _ "Jet OLEDB:Database Password='****';" Set rs = CreateObject("ADODB.Recordset") rs.Open "SELECT * FROM TEST2", cn, , , adCmdText ' Write the field names For intColIndex = 0 To rs.Fields.Count - 1 TargetRange.Offset(1 - 1, intColIndex).Value = rs.Fields(intColIndex).Name 'ori nie bylo -1 Next ' Write recordset TargetRange.Offset(1, 0).CopyFromRecordset rs LetsContinue: On Error Resume Next rs.Close Set rs = Nothing cn.Close Set cn = Nothing On Error GoTo 0 Exit Sub Whoa: MsgBox "Error Description :" & Err.Description & vbCrLf & _ "Error at line :" & Erl & vbCrLf & _ "Error Number :" & Err.Number Resume LetsContinue End Sub
Aktualizowanie tabeli w bazie danych Access poprzez Excel VBA:
Sub Update_Table() 'Add Reference to Microsoft ActiveX Data Objects 2.x Library Dim strConnectString As String Dim objConnection As ADODB.Connection Dim strDbPath As String Dim strTblName As String 'Set database name and DB connection string-------- strDbPath = ThisWorkbook.Path & "\TestDB.accdb" '================================================== strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";" 'Connect Database; insert a new table Set objConnection = New ADODB.Connection On Error Resume Next With objConnection .Open strConnectString .Execute "UPDATE TEST" & _ " SET Nazwisko='Kowalski', Lat=90" & _ " WHERE Imie='Pawel'" End With Set objConnection = Nothing End Sub