ADODB Insert into another sheet - sql

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 & "');"

Related

Issue Referencing Column in VBA SQL Query

I have an excel spreadsheet that I'm trying to perform SQL queries on. I get "no value given for one or more required parameters", so I think it's a problem with my query. I can do a query like "SELECT * FROM [Employee$A2:A4]", but when I reference a particular column using the name (i.e. name, title...etc, or even using the generic column reference like F1) I get "No value given for one or more required parameters."
Here's my code:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT Employee FROM [Employee$] AS e WHERE e.Skill_Title = " & """" & skillTitle & """" & " AND e.Branch = " & """" & branchTitle & """" & " AND e.Skill_Prof = 5"
rs.Open strSQL, cn
MsgBox (rs.GetString)
Any ideas what might be going on?
Try applying the following example.
Tell me if the problem persists and the inputs you're using.
I have this on Employee sheet:
Created "MyQuery" subprocess as follows (as you can see, this is a replica of your code, with some little differences):
Sub MyQuery(ByVal skillTitle As String, _
ByVal branchTitle As String, _
ByVal skillProf As Integer)
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=Yes;" & _
"IMEX=1"";"
Set Cn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")
Cn.Open strCon
strSQL = _
"SELECT Employee " & _
"FROM [Employee$] AS e " & _
"WHERE e.Skill_Title = '" & skillTitle & "' AND " & _
"e.Branch = '" & branchTitle & "' AND " & _
"e.Skill_Prof = " & CStr(skillProf)
Rs.Open strSQL, Cn
MsgBox (Rs.GetString)
'Do not forget closing your connection'
Rs.Close
Cn.Close
End Sub
Made a quick test:
Sub test()
'Try running this'
Call MyQuery("FOUR", "Y", 5)
End Sub
Result:
Have you named the columns? I wasn't sure from your code example whether you had named the columns or were assuming the column header would suffice for a reference. A "named" column is not the same as using a column header. To access the column by name try assigning a name to the column first.
From: How to give a name to the columns in Excel
Click the letter of the column you want to change and then click the "Formulas" tab.
Click "Define Name" in the Defined Names group in the Ribbon to open the New Name window.
Enter the new name of the column in the Name text box.

Use Table name in SQL query in VBA Excel

Below is the excel table i want to manipulate via SQL query in VBA.
Please find my VBA code.
Sub SQL()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT [Sr] FROM [Table1$] WHERE [Sr] >= 3 AND [Sr] <= 8;"
rs.Open strSQL, cn
Sheet5.Range("D1").CopyFromRecordset rs
End Sub
I am getting below error for my above code.
Please guide how can i manipulate excel table in SQL query in VBA.
Querying the ListObject's range using a table alias will work.
SQL
SELECT [Sr] FROM [Sheet1$A1:D15] AS [Table1] WHERE [Sr] >= 3 AND [Sr] <= 8;
Code
Sub SQL()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT [Sr] FROM " & getListObjectSQLAdress(Sheet1.ListObjects(1)) & " WHERE [Sr] >= 3 AND [Sr] <= 8;"
rs.Open strSQL, cn
Sheet5.Range("D1").CopyFromRecordset rs
End Sub
Function getListObjectSQLAdress(tbl As ListObject) As String
getListObjectSQLAdress = "[" & tbl.Parent.Name & "$" & tbl.Range.Address(False, False) & "] AS [" & tbl.Name & "]"
End Function
Alternative method to build a valid SQL Query Table name from a ListObject.Range
Function getListObjectSQLAdress2(tbl As ListObject) As String
Dim s As String
s = tbl.Range.Address(False, False, xlA1, xlExternal)
s = Replace(s, "'[", "`")
s = Replace(s, "]", "`.[")
s = Replace(s, "'!", "$")
getListObjectSQLAdress2 = s & "] AS [" & tbl.Name & "]"
End Function
Table Name Output
`Untitled (4).xlsx`.[Sheet1$A1:D15] AS [Table1]

Append queried Recordset to Table in Access

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

Open/Close ADO Connection

I am trying to import data from Access to Excel. There are four columns in the Access table: Date, Time, Tank, Comments. On importing the Time and Tank columns, I sort them based on date. Additionally, I import them separately so I can swap the column order form Time, Tank to Tank, Time. In the programming I have to close and open the ADO connection for that. I want to make the program more efficient by avoiding closing the connection and having to open it again. Any suggestions/solutions? Thanks.
Sub ADOImportFromAccessTable()
Dim DBFullName As String
Dim TankRange As Range
Dim TimeRange As Range
Dim RpDate
Dim TankSelect As String
Dim TimeSelect As String
Dim r As Long
DBFullName = "U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb"
Worksheets("TankHours").Activate
Set TankRange = Range("C5")
Set TimeRange = Range("D5")
Set RpDate = Range("B2").Cells
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TankRange = TankRange.Cells(1, 1)
Set TimeRange = TimeRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
' filter rows based on date
TankSelect = "SELECT u.Tank" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TankRange.CopyFromRecordset rs
'End With
'rs.Close
' Set rs = Nothing
cn.Close
' Set cn = Nothing
' Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
'Set rs = New ADODB.Recordset
' With rs
'' open the recordset
'' filter rows based on date
TimeSelect = "SELECT u.Time" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TimeSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TimeRange.CopyFromRecordset rs
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Recordset columns are returned in the order of your Select statement. So if you want Tank to be first then list it first like this: TankSelect = "SELECT u.Tank, u.Time... rest of your code
Simple example:
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
Set rs = New ADODB.Recordset
TankSelect = "SELECT u.Tank, u.Time" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Tank;"
rs.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TankRange.CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
You can also return specific fields to an array by using GetRows. This also allows you to manipulate your results without having to make any other call to the database. Here is an example:
Dim FieldsToSelect(0 To 1) As Variant
FieldsToSelect(0) = "TankVal"
FieldsToSelect(1) = "TimeVal"
With rs
TankSelect = "SELECT u.Tank AS TankVal, u.Time AS TimeVal" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Tank;"
.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
ResultsArray = .GetRows(Fields:=FieldsToSelect)
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
'Do what you want with array of results
The ResultsArray will list the field results in the order that you declare them in FieldsToSelect
Of course, another option is to just loop through your recordset and output the specific fields into specific cells.
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TankRange = TankRange.Cells(1, 1)
Set TimeRange = TimeRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
' filter rows based on date
TankSelect = "SELECT u.Tank" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TankSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TankRange.CopyFromRecordset rs
'End With
'rs.Close
' Set rs = Nothing
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
"U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb" & ";"
'Set rs = New ADODB.Recordset
' With rs
'' open the recordset
'' filter rows based on date
TimeSelect = "SELECT u.Time" & vbCrLf & _
"FROM UnitOneRouting AS u" & vbCrLf & _
"WHERE u.Date = " & Format(RpDate, "\#yyyy-m-d\#") & vbCrLf & _
"ORDER BY u.Time, u.Tank;"
.Open TimeSelect, cn, adOpenStatic, adLockOptimistic, adCmdText
TimeRange.CopyFromRecordset rs
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I haven't tested this, but all I did was remove the cn.Close and changed it, so it will just change the connection string (not sure if that is the right property, but I'm sure there is aproperty for it). Then I left the close it at the end.
Several things can be improved in your example:
1) You don't need to close connection to run another query (open different recordset),
2) You select from the same table using the same where condition twice, I would be much better
to select both in one query and populate two cells in one go,
3) Not using SQL parameters is a bad programming practice,
Example
Sub ADOImportFromAccessTable()
Dim DBFullName As String
Dim TankRange As Range
Dim Cmd1 As ADODB.Command
Dim Param1 As ADODB.Parameter
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
DBFullName = "U:\Night Sup\Production Report 2003 New Ver 5-28-10_KA.mdb"
Worksheets("TankHours").Activate
Set TankRange = Range("C5")
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullName & ";"
Set Cmd1 = New ADODB.Command
Cmd1.CommandText = "select Tank, Time from UnitOneRouting where Date = ?"
Cmd1.CommandType = adCmdText
Cmd1.ActiveConnection = cn
Set Param1 = Cmd1.CreateParameter("date1", adDate, adParamInput, , Range("B2").Value)
Cmd1.Parameters.Append Param1
Set rs = Cmd1.Execute()
TankRange.CopyFromRecordset rs, 1 ' copy just one row, ignore rest if there are more
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

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"