After some searching I have found a macro to export an Excel sheet as record in a password protected Access database
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim i As Long
'add error handling
On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = ("\\serverpath\reporting.accdb")
'Initialise the collection class variable
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath, , "password"
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open Source:="table", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
rst.AddNew
For i = 1 To 180
rst(Cells(1, i).Value) = Cells(nextrow, i).Value
Next i
rst.Update
'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'communicate with the user
MsgBox " The data has been successfully sent to the access database"
'Update the sheet
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
I get an error "Error 2147217843 The workgroup information file is missing" at cnn.Open
That error message is misleading. The problem is not about a MDW (workgroup information file).
There are 2 types of passwords for Access databases:
passwords associated with individual Access security user accounts
a password which applies to the database itself, and all users must supply that password to open the database
Your password is the second type, but your connection attempt treats it as the first type.
Use the Jet OLEDB:Database Password option in your connection string.
Dim strConnect As String
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dbPath & ";Jet OLEDB:Database Password='password';"
Debug.Print strConnect
cnn.Open strConnect
You could try passing the info about the workgroup file, though I believe it primarily is for mdb files:
Provider=Microsoft.Jet.OLEDB.12.0;Data Source=D:\Test\Test.accdb;User ID=Admin;Jet OLEDB:System database=D:\Test\System.mdw;
Related
Previously I have an Excel program that uses macro to perform an SQL query within the Excel itself.
Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String)
Dim rsData As ADODB.Recordset
Dim szConnect As String
On Error GoTo ErrHandler
Application.StatusBar = "Retrieving data ....."
'Set up the connection string to excel - thisworkbook
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & wbWorkBook & ";" & _
"Extended Properties=Excel 8.0;"
Set rsData = New ADODB.Recordset
'Run the query as adCmdText
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
'Check if data is returned
If Not rsData.EOF Then
'if the recordset contains data put them on the worksheet
rgStart.CopyFromRecordset rsData
Else
' MsgBox "There's no records that matches the query !!", vbCritical
End If
'Close connection
rsData.Close
'Clean up and get out
Set rsData = Nothing
Application.StatusBar = False
Exit Sub
ErrHandler:
'an error occured in the SQL-statement
MsgBox "Your query could not be executed, the SQL-statement is incorrect."
Set rsData = Nothing
Application.StatusBar = False
End Sub
On my old PC it worked fine. But now that I've changed to a new laptop I keep having problems with the macro. As it goes straight to error handler the moment it passes the line rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText.
I checked the References and made sure ActiveX Data Objects was selected. But still no dice.
What else am I possible missing here?
I have been using the below code which I have got from one of website, however, the user always tend to forget to check whether the data (IDs) are already sent to the Access Database, is there any way to loop the process and still export the data and change the font color of item not processed and introduce a new column with text "Not Imported"?
Sub Export_Data()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
'add error handling
On Error GoTo errHandler:
'On Error Resume Next
'Variables for file path and last row of data
dbPath = ActiveSheet.Range("I3").Value
nextrow = Cells(Rows.Count, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Check for data
If Sheet1.Range("A2").Value = "" Then
MsgBox " Add the data that you want to send to MS Access"
Exit Sub
End If
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="PhoneList", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'you now have the recordset object
'add the values to it
For x = 2 To nextrow
rst.AddNew
For i = 1 To 7
rst(Cells(1, i).Value) = Cells(x, i).Value
Next i
rst.Update
Next x
'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'communicate with the user
MsgBox " The data has been successfully sent to the access database"
'Update the sheet
Application.ScreenUpdating = True
'show the next ID
'Sheet1.Range("J3").Value = Sheet1.Range("K3").Value + 1
'Clear the data
'Sheet1.Range("A2:G1000").ClearContents
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
Appreciate any help, as I don't know how to begin with the loop resume next. I hope you guys can help me change or modify this code.
After reading the Code, I think I finally understood what you wanted to do:
You wanted to check first if the Row has been exported or not before proceeding
So here is the updated Script.
I changed the sequence of several sections of the code as they were not coherent or will cause you errors.
I added a Column H supposing your columns are A to G, where H will store «Exported» after it has been successfully stored on the Database.
So this should work for you now:
Main Sub Exporting to Access
Sub Export_Data_Updated()
Dim dbPath As String
Dim lastRow As Long
Dim exportedRowCnt As Long
'add error handling
On Error GoTo exitSub
'Check for data
'##> This should be first as it is useless to open cnx or find path/last row if this will exit the sub
If Sheet1.Range("A2").Value = "" Then
MsgBox " Add the data that you want to send to MS Access"
Exit Sub
End If
'##> Only Continue when the above is fine
'##> Check if the path exits first
'Variables for file path
dbPath = ActiveSheet.Range("J3").Value '##> This was wrong before pointing to I3
If Not FileExists(dbPath) Then
MsgBox "The Database file doesn't exist! Kindly correct first"
Exit Sub
End If
'##> Only then that you can proceed
'find las last row of data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'##> Change the Error handler now
Dim cnx As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
On Error GoTo errHandler
'Initialise the collection class variable
Set cnx = New ADODB.Connection
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="PhoneList", ActiveConnection:=cnx, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'##> Continue reading Database now
'you now have the recordset object
'add the values to it
'Wait Cursor
Application.Cursor = xlWait
'Pause Screen Update
Application.ScreenUpdating = False
'##> Set exportedRowCnt to 0 first
exportedRowCnt = 0
'##> Let's suppose Data is on Column A to G.
' --> So let's put the "Exported" on Column H
For nRow = 2 To lastRow
'##> Check if the Row has already been imported?
'If it it isn't then continue
If IdExists(cnx, Range("A" & nRow).Value) Then
'Item already exported, so update the Status
Range("H" & nRow).Value2 = "Exported"
Else
rst.AddNew 'Add New RecordSet
'Itirating Columns
For nCol = 1 To 7
rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
Next nCol
rst.Update 'Update RecordSet
'##>Update the Status on Column H when the record is successfully updated
Range("H" & nRow).Value2 = "Exported"
'Increment exportedRowCnt
exportedRowCnt = exportedRowCnt + 1
End If
Next nRow
'close the recordset
rst.Close
' Close the connection
cnx.Close
'clear memory
Set rst = Nothing
Set cnx = Nothing
If exportedRowCnt > 0 Then
'communicate with the user
MsgBox exportedRowCnt & " row(s) successfully sent to the access database"
End If
'Update the sheet
Application.ScreenUpdating = True
exitSub:
'Restore Default Cursor
Application.Cursor = xlDefault
'Update the sheet
Application.ScreenUpdating = True
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnx = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
Resume exitSub
End Sub
Function Checking if File Exists:
NB: Now valid ID is only String Type
Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean
'##> Set IdExists as False and change to true if the ID exists already
IdExists = False
'##> Change the Error handler now
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim cmd As ADODB.Command 'dim the ADO command class
On Error GoTo errHandler
'Sql For search
Dim sSql As String
sSql = "SELECT Count(PhoneList.ID) AS IDCnt FROM PhoneList WHERE (PhoneList.ID='" & sId & "')"
'##> Execute command and collect it into a Recordset
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnx
cmd.CommandText = sSql
'ADO library is equipped with a class named Recordset
Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset
'Read First RST
rst.MoveFirst
'##> If rst returns a value then ID already exists
If rst.Fields(0) > 0 Then
IdExists = True
End If
'close the recordset
rst.Close
'clear memory
Set rst = Nothing
exitFunction:
Exit Function
errHandler:
'clear memory
Set rst = Nothing
MsgBox "Error " & Err.Number & " :" & Err.Description
End Function
NB: Kindly read any comments preceeded by «'##>» as those are principal changes or explanations you need to understand
Updates:
Here is the File after the updates: https://drive.google.com/open?id=1XqEboSFed_6exDwvBZGOqcZWkN8YaslY
---> Fortunately, you sent me the file as I saw the DbPath was pointing on a wrong cell causing a missing file error. Now all is Fixed and working!
I wish you all the best!
I want to send data from my excel file to access. It worked perfectly until I wanted to try and secure the database by putting a password on it. Now I just keep getting "Not a Valid Password".
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim pword As String
Dim strcon As String
Dim X As Long, i As Long
Dim nextrow As Long
Application.DisplayAlerts = True
'add error handling
'On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = Sheet1.Range("M5").Value
pword = "MyPassword"
strcon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";"
& _ "Jet OLEDB:Database Password=" & pword & ";"
'nextrow = Cells(Rows.Count, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Check for data
If Sheet1.Range("B5").Value = "" Then
MsgBox " Add the data that you want to send to MS Access"
Exit Sub
End If
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open strcon
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-
Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="Food_Deliveries", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
I have tried changing the password multiple times with no luck. The password keeps getting rejected in the code.
I have a Userform in Excel with four textboxes. Each text box corresponds to a field of Table1 in Access.
I’m would like to return MAX row ID value from a table in Access, add 1 to that value, and to display that value in a textbox on the userform.
After I enter values into the other 3 text boxes, I would like to export data to Table1 in Access.
Can this all be accomplished in the same subroutine? Please help me incorporate sql statement in the correct location in the code.
Thank you
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim x As Long, i As Long
Dim PrimaryField As String
Dim MyTable As String
Dim GetLastPrimaryKey As Variant
PrimaryField = "ID"
MyTable = "Table1"
'Erro handler
On Error GoTo errHandler:
'dbPath = ActiveSheet.Range("H500").Value
dbPath = "H:\Annie\File.accdb"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
sql = "SELECT MAX([" & PrimaryField & "]) FROM [" & MyTable & "];"
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="Table1", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'rst.Open sql, cnn
GetLastPrimaryKey = rst.Fields(0).Value
MsgBox (GetLastPrimaryKey)
GetLastPrimaryKey = Arec1.Value
'you now have the recordset object
'alternative code
With rst
.AddNew
.Fields("ID").Value = Arec1
.Fields("patient").Value = Arec2
.Fields("test").Value = Arec3
.Fields("CommentTxt").Value = Arec4
.Update
End With
'clear the userform values
For x = 1 To 4
UserForm1.Controls("Arec" & x).Value = ""
Next
'add the next user ID
'Me.Arec1 = Sheet1.Range("J3").Value
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'commuinicate with the user
MsgBox " The data has been successfully sent to the access database"
On Error GoTo 0
Exit Sub
errHandler:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd"
End Sub
Consider opening a new recordset. Of course, change the Excel userform textbox name (placeholder here):
Set maxIDrst = New ADODB.Recordset
sql = "SELECT MAX([" & PrimaryField & "]) + 1 as MaxIDPlusOne FROM [" & MyTable & "];"
maxIDrst.Open sql, conn
UserForm1.Controls("Arec5").Value = maxIDrst!MaxIDPlusOne
maxIDrst.Close
...
Set maxIDrst = nothing
We are frequently using some Excel files as a datasource for massive imports in our database. At the code level, we always refer to the corresponding data source as:
set rs = New ADODB.recordset
rs.open "SELECT * FROM [sheet1$]", myConnectionString, etc
Of course, this procedure only works when there's a sheet in the Excel file which is named [sheet1]. I'd like to add some sheet management code here, but without having to create an instance of the original Excel file, opening it, and so on (my users might get a file with a different sheet name, and might not have Excel installed).
Any idea?
You can open a recordset with the ADO OpenSchema method and then list the table (sheet) names in your workbook.
Public Sub SheetsInWorkbook()
Dim strConnect As String
Dim cn As Object
Dim rs As Object
Dim strPath As String
strPath = CurrentProject.Path & Chr(92) & "temp.xls"
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source='" & strPath & "';" _
& "Extended Properties='Excel 8.0';"
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = strConnect
cn.Open
Set rs = cn.OpenSchema(20) '20 = adSchemaTables '
Debug.Print "TABLE_NAME"
Do While Not rs.EOF
Debug.Print rs!TABLE_NAME
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub