Append queried Recordset to Table in Access - sql

I am querying Active Directory to list Users and other fields in Access. Is there a way to append my queried results into an existing table? Currently I am trying to use INSERT INTO but having issues with my Object variable not being set or block variable.
Private Sub Command0_Click()
Dim objRecordSet As Object
Dim objCommand As Object
Dim objConnection As Object
Dim dbs As Database
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Sort On") = "whenCreated"
objCommand.CommandText = _
"SELECT Name,Title,PhysicalDeliveryOfficeName,WhenCreated,Mail FROM 'LDAP://OU=Standard Users,OU=Active Users,OU=All Users,DC=contoso,dc=local' WHERE objectCategory='user'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
dbs.Execute " INSERT INTO ADUsers" & "(Name,Title,Site,Created,Email) VALUES " & "(objRecordSet.Fields('Name').Value,objRecordSet.Fields('Title').Value,objRecordSet.Fields('physicalDeliveryOfficeName').Value,objRecordSet.Fields('whenCreated').Value,objRecordSet.Fields('Mail').Value);"
dbs.Close
Debug.Print objRecordSet.Fields("Name").Value; "," & objRecordSet.Fields("Title").Value; "," & objRecordSet.Fields("physicalDeliveryOfficeName").Value; "," & objRecordSet.Fields("whenCreated").Value; "," & objRecordSet.Fields("Mail").Value
objRecordSet.MoveNext
Loop
End Sub

Everything inside doublequotes " is interpreted as string not as code and strings (the values of objRecordSet.Fields("myFieldName").Value) have to be quoted in insert statement.
dim strSQLInsert as String
strSQLInsert = "INSERT INTO ADUsers(Name,Title,Site,Created,Email) VALUES ('" & _
objRecordSet.Fields("Name").Value & "','" & _
objRecordSet.Fields("Title").Value & "','" &
objRecordSet.Fields("physicalDeliveryOfficeName").Value & "','" & _
objRecordSet.Fields("whenCreated").Value & "','" & _
objRecordSet.Fields("Mail").Value & "');"
Debug.Print strSQLInsert
dbs.Execute strSQLInsert
Store your sql statements in a string, then you can check it with Debug.Print.

Consider a parameterized query using querydefs to avoid the need of quotes. Also be sure to initialize the database object which may be your main issue: set dbs = CurrentDb.
...
Dim strSQL As String
Set dbs = CurrentDb
strSQL = "PARAMETERS NameParm TEXT(255), TitleParam TEXT(255), SiteParam TEXT(255)," _
& " CreatedParm Date, EmailParam TEXT(255);" _
& " INSERT INTO ADUsers (Name, Title, Site, Created, Email)" _
& " VALUES ([NameParm], [TitleParam], [SiteParam], [Created], [Email]);"
Do Until objRecordSet.EOF
Set qdef = dbs.CreateQueryDef("", strSQL)
qdef!NameParam = objRecordSet![Name]
qdef!TitleParam = objRecordSet![Title]
qdef!SiteParam = objRecordSet![PhysicalDeliveryOfficeName]
qdef!CreatedParam = objRecordSet![WhenCreated]
qdef!EmailParam = objRecordSet![Mail]
qdef.Execute (dbfailOnError)
Set qdef = Nothing
objRecordSet.MoveNext
Loop

Related

Data Type Mismatch error while using the SQL Update query

I am using SQL update query in VBA and I am getting the datatype mismatch error. I know that error is basically because of the column spare part. The spare part column contains numeric and alphanumeric values.
Public Function UpdateDistinctColumnFRNumberBasis()
StrInvoiceNumber = "109839-01"
FRSparepartNumber = "FT7119907459"
MergedInvoiceFile = "/test.xlsx"
Dim objConn As Object
Dim objRecordSet As Object
Set objConn = CreateObject("ADODB.Connection")
Set objRecCmd = CreateObject("ADODB.Command")
Set objRecCmd_Update = CreateObject("ADODB.Command")
objConn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
MergedInvoiceFile & ";Extended Properties=""Excel 8.0;""")
strSQL = " Update [Tabelle1$] SET [Status] = 'Include' Where " & _
"([RECHNR] ='" & StrInvoiceNumber & "' AND [Sparepart] = " & FRSparepartNumber & ")"
objConn.Execute strSQL
objConn.Close
End Function
As commented, the partnumber is text, thus it must be quoted in the SQL:
FRSparepartNumber = "FT7119907459"
' snip
strSQL = "Update [Tabelle1$] SET [Status] = 'Include' Where " & _
"([RECHNR] = '" & StrInvoiceNumber & "' AND " & _
"[Sparepart] = '" & FRSparepartNumber & "')"

Apostrophe in memo text causing error in code

I am using Access 2016 and I am running into an error where a memo field gets updated and people are using apostrophes and it interferes with the code to update. The code works great and it updates the table for specific values unless there is an apostrophe present. No amount of parentheses or brackets have resolved this issue to isolate the apostrophes in text from the code. I would prefer suggestions that would I allow me to have apoostrophes if possible.
Private Sub btnlledit_Click()
Dim SQL As String
SQL = "UPDATE tblll " & _
"SET [LLN] = '" & Forms!frmaddll!txtlln & "',[REF] = '" & Forms!frmaddll!txtllref & "',[TRN] = '" & Forms!frmaddll!txtlltr & "',[HN] = '" & Forms!frmaddll!txtllhull & "', [LL] = '" & Forms!frmaddll!txtll & "',[CA] = '" & Forms!frmaddll!txtllca & "',[CP] = '" & Forms!frmaddll!txtllcomponent & "',[LOC] = '" & Forms!frmaddll!txtllloc & "',[LFSE] = '" & Forms!frmaddll!txtlllfse & "',[FC] = '" & Forms!frmaddll!txtllfc & "' " & _
"WHERE [LLN] = '" & Forms!frmaddll!txtlln.Value & "';"
DoCmd.RunSQL SQL
DoCmd.Requery
Me.Refresh
End Sub
I've cut down your SQL to give you an idea.
The first line of SQL are the parameters - note the ; at the end of the first line.
Private Sub btnlledit_Click()
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.CreateQueryDef("", _
"PARAMETERS LLN_Value TEXT(255), REF_Value TEXT(255), TRN_Value TEXT(255); " & _
"UPDATE tblll " & _
"SET LLN = LLN_Value, REF = REF_Value, TRN = TRN_Value " & _
"WHERE LLN = LLN_Value")
With qdf
.Parameters("LLN_Value") = Forms!frmaddll!txtlln
.Parameters("REF_Value") = Forms!frmaddll!txtllref
.Parameters("TRN_Value") = Forms!frmaddll!txtlltr
.Execute
End With
End Sub
A better way would be to move the execution of the query to another procedure and pass the required values to that:
Public Sub MyQuery(My_LLN_Value AS String, My_Ref_Value AS String, My_TRN_Value AS String)
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.CreateQueryDef("", _
"PARAMETERS LLN_Value TEXT(255), REF_Value TEXT(255), TRN_Value TEXT(255); " & _
"UPDATE tblll " & _
"SET LLN = LLN_Value, REF = REF_Value, TRN = TRN_Value " & _
"WHERE LLN = LLN_Value")
With qdf
.Parameters("LLN_Value") = My_LLN_Value
.Parameters("REF_Value") = My_Ref_Value
.Parameters("TRN_Value") = My_TRN_Value
.Execute
End With
End Sub
You can then call this procedure from your button click:
Private Sub btnlledit_Click()
MyQuery Forms!frmaddll!txtlln, Forms!frmaddll!txtllref, Forms!frmaddll!txtlltr
End Sub
Or from elsewhere, and getting your values from elsewhere to:
Public Sub Test
Dim Second_Arg AS String
Second_Arg = "Some Reference Value"
MyQuery Forms!frmaddll!txtlln, Second_Arg, "Third Argument"
End Sub
I said in a minute but had other stuff (+ writing this in VBA is a torture):
Dim SQL As String
SQL = "UPDATE tblll " & _
"SET [REF] = #ref,[TRN] = #trn,[HN] = #hn" & _
", [LL] = #ll,[CA] = #ca,[CP] = #cp,[LOC] = #loc " & _
", [LFSE] = #lfse, [FC] = #fc" & _
"WHERE [LLN] = #lln";"
Dim oConnection As ADODB.Connection
Dim oCommand As ADODB.Command
Set oConnection = New ADODB.Connection
Set oCommand = New ADODB.Command
oConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\MyFolder\MyData.accdb;"
oConnection.Open
oCommand.ActiveConnection = oConnection
oCommand.CommandText = SQL
oCommand.Parameters.Append oCommand.CreateParameter("#ref", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#trn", adVarChar, adParamInput, 100)
oCommand.Parameters.Append oCommand.CreateParameter("#hn", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#ll", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#ca", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#cp", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#loc", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#lfse", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#fc", adInteger)
oCommand.Parameters.Append oCommand.CreateParameter("#lln", adInteger)
oCommand.Parameters("#ref" ).Value = Forms!frmaddll!txtref.Value
oCommand.Parameters("#trn" ).Value = Forms!frmaddll!txttrn.Value
oCommand.Parameters("#hn" ).Value = Forms!frmaddll!txthn.Value
oCommand.Parameters("#ll" ).Value = Forms!frmaddll!txtll.Value
oCommand.Parameters("#ca" ).Value = Forms!frmaddll!txtca.Value
oCommand.Parameters("#cp" ).Value = Forms!frmaddll!txtcp.Value
oCommand.Parameters("#loc" ).Value = Forms!frmaddll!txtloc.Value
oCommand.Parameters("#lfse").Value = Forms!frmaddll!txtlfse.Value
oCommand.Parameters("#fc" ).Value = Forms!frmaddll!txtfc.Value
oCommand.Parameters("#lln" ).Value = Forms!frmaddll!txtlln.Value
oCmd.Execute
This code is not specifically an access code but VBA (that you can execute from any VBA environment, say Excel, Word ...).
Since I don't know your fields, parameter types are just for sampling. The important thing here is, you have to define the parameters in the same order as they appear in your query string. After appending the parameters, you are free to set their values in any order you like (that is a limitation in driver I think, parameters are not named but positional).
NOTE: I dropped initial LLN= because you were searching for it and setting to the same value (IOW no change).
Single quotes are escaped by doubling them up, just as you've shown us in your example. The following SQL illustrates this functionality.
BTW, Go for SQL Parameter instead of these inline SQL Injection.
Try like below:
Private Sub btnlledit_Click()
Dim SQL As String
SQL = "UPDATE tblll " & _
"SET [LLN] = '" & Forms!frmaddll!txtlln & "',[REF] = '" & Forms!frmaddll!txtllref & "',[TRN] = '" & Forms!frmaddll!txtlltr & "',[HN] = '" & Forms!frmaddll!txtllhull & "', [LL] = '" & Forms!frmaddll!txtll & "',[CA] = '" & Forms!frmaddll!txtllca & "',[CP] = '" & Forms!frmaddll!txtllcomponent & "',[LOC] = '" & Forms!frmaddll!txtllloc & "',[LFSE] = '" & Forms!frmaddll!txtlllfse & "',[FC] = '" & Forms!frmaddll!txtllfc & "' " & _
"WHERE [LLN] = '" & Forms!frmaddll!txtlln.Value & "';"
Replace (SQL, "'", "''")
DoCmd.RunSQL SQL
DoCmd.Requery
Me.Refresh
End Sub

ADODB Insert into another sheet

I am trying to create a record on another excel sheet with SQL insert command I am able to select with query but I don't know exactly how to insert a record my code is:
Function database_add(Urun_barkodu, Urun_kodu, Urun_adi, Urun_kategori) As String
Dim cn As Object, rs As Object, output As String, sql As String, Insert As String
Dim add_data As String
Dim rst As ADODB.Recordset
'---Connecting to the Data Source---
Set cn = CreateObject("ADODB.Connection")
Set rst = New ADODB.Recordset
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
add_data = "INSERT INTO [ürünler$] (columns(1),columns(2),columns(3),columns(4))"
add_data = add_data & "VALUES (Urun_barkodu, Urun_kodu, Urun_adi, Urun_kategori)"
cn.Close
cn.Open
rst.Open add_data, cn, dOpenStatic, adLockReadOnly, adCmdText
'---Clean up---
rs.Close
cn.Close
Set cn = Nothing
Set rs = Nothing
End Function
It gives me an error like:
syntax error in INSERT INTO STATEMENT
I'm guessing that Urun_barkodu, Urun_kodu, Urun_adi and Urun_kategori are string vars. You need to concatenate them into the string.
add_data = "INSERT INTO [ürünler$] (columns(1),columns(2),columns(3),columns(4)) "
add_data = add_data & "VALUES ('" & Urun_barkodu & "', '" & Urun_kodu& "', '" & Urun_adi & "', '" & Urun_kategori & "');"

MS EXCEL to MS ACCESS .accdb Database from VBA SQL Syntax error

I am completely stuck and pulling out my hair on this one..
From Excel VBA I have two sets of code:
1- To Create a table is MS Access via a SQL statement
2- Populated newly created table with a For loop, also using SQL
The first set of code works perfectly, so I know that my connection string is working properly.
Here is the first set:
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("Contract List")
Set wCD = Worksheets("Contract Data")
'Set database name and DB connection string--------
strDbPath = ThisWorkbook.Path & "\SpreadPrices.accdb"
'==================================================
strTblName = wCL.Range("TableName").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 " & strTblName & " (" & _
"[cDate] text(150), " & _
"[Open] text(150), " & _
"[High] text(150), " & _
"[Low] text(150), " & _
"[Last] text(150), " & _
"[cChange] text(150), " & _
"[Settle] text(150), " & _
"[cVolume] text(150), " & _
"[OpenInterest] text(150))"
End With
Set objConnection = Nothing
End Sub
Mentioned before that code works perfectly. The bug is on the following set of code used to populate the table.
Here it is:
Sub InsertSQL()
'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 lngRow As Long
Dim strSQL As String
Dim wCL As Worksheet
Dim wCD As Worksheet
Set wCL = Worksheets("Contract List")
Set wCD = Worksheets("Contract Data")
'Set database name and DB connection string--------
strDbPath = ThisWorkbook.Path & "\SpreadPrices.accdb"
'==================================================
strTblName = wCL.Range("TableName").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
For lngRow = 2 To Range("NumberRows").Value
strSQL = "INSERT INTO " & strTblName & " (" & _
"cDate, Open, High, Low, Last, cChange, Settle, cVolume, OpenInterest)" & _
" VALUES ('" & _
wCD.Cells(lngRow, 1) & "' , '" & _
wCD.Cells(lngRow, 2) & "' , '" & _
wCD.Cells(lngRow, 3) & "' , '" & _
wCD.Cells(lngRow, 4) & "' , '" & _
wCD.Cells(lngRow, 5) & "' , '" & _
wCD.Cells(lngRow, 6) & "' , '" & _
wCD.Cells(lngRow, 7) & "' , '" & _
wCD.Cells(lngRow, 8) & "' , '" & _
wCD.Cells(lngRow, 9) & "')"
wCL.Range("A1").Value = strSQL
.Execute strSQL
Next lngRow
End With
Set objConnection = Nothing
End Sub
The error I receive is:
Run-time error, Syntax error in INSERT INTO statement.
Ok, so at first thought I think there must be a error in my SQL string. So I take the exact SQL string and toss it into Access Query Builder and run the SQL command and it imports into the table just fine.
What am I missing?
The problem may be due to field names. There is a function named CDate. Open and Last are both Jet reserved words. See Problem names and reserved words in Access.
Enclose those problem field names in square brackets to avoid confusing the database engine:
"[cDate], [Open], High, Low, [Last], cChange, Settle, cVolume, OpenInterest)"
The brackets may be enough to get your INSERT working. However consider renaming the fields if possible.
That linked page also mentions Allen Browne's Database Issue Checker Utility. You can download that utility and use it to examine your database for other problem names. It can also alert you to other issues which may not affect the current INSERT problem, but could cause trouble in other situations.

Delete all records from table - doCMD.RunSQL

I am looking to clear a local table of all records before adding new data to it. I am trying to do this using the doCMD.RunSQL command but keep receiving run time error I am guessing because of its placement within the open connection, I am unsure on how to get this to execute.
Any help appreciated.
Thanks
Sub GetUsers()
Dim oConnection As Object
Dim oSheet As Object
Dim oCell As Object
Set oConnection = CreateObject("ADODB.Connection")
Dim strDBPath As String
strDBPath = "C:/Users/stevemcco/Desktop/Users.accdb"
Dim sConn As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strDBPath & ";" & _
"Jet OLEDB:Engine Type=5;" & _
"Persist Security Info=False;"
oConnection.Open sConn
DoCmd.RunSQL "Delete * from Table1"
For Each oSheet In ThisWorkbook.Sheets
For Each oCell In oSheet.Columns(1).Cells
If oCell.Value = "" Then
Exit For
End If
If (oCell.Row > 1) Then 'Jumps the header
oConnection.Execute " Insert Into Table1(ID,Area) " _
& " VALUES ('" & oCell.Value & "','" & oSheet.Name & "')"
End If
Next
Next
oConnection.Close
Set oConnection = Nothing
End Sub
for local database you would use: CurrentDb.Connection.Execute "DELETE * FROM Table1"
In your case use: oConnection.Execute "DELETE * FROM Table1"