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"
Related
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 & "');"
Hello stackoverflow community,
I'm using a macro to pull data from one worksheet to another but I keep receiving the error "The microsoft access database engine could not find the object 'sheet1$'". I know for sure that the referenced file has Sheet1 and the path is correct. What may be the problem is that the multiple referenced files were created in the same workbook and saved as separate files afterward. So when I open one of the referenced files it's displayed as, say, Sheet2343(Sheet1) and that's what I think creates the problem- the macro is looking for Sheet1 in the workbook but finds only Sheet2343 and therefore return an error message. Below is the code I'm using. Could anyone,please, suggest a workaround?
Thanks!
Sub Pull_Data()
Dim rsData As ADODB.Recordset
rsFile$ = ThisWorkbook.Path & "\" & Sheet1.Range("C1") & ".xlsx"
strConn$ = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & rsFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
rsSQL$ = "SELECT * FROM [Sheet1$]"
Set rsData = New ADODB.Recordset
rsData.Open rsSQL, strConn, , adOpenUnspecified, adLockUnspecified
Sheet1.Range("F4").CopyFromRecordset rsData
End Sub
EDIT: for your use case something like this
Sub Pull_Data()
Dim rsData As ADODB.Recordset, sheetName
Dim rsFile As String, strConn, rsSQL
rsFile = ThisWorkbook.Path & "\" & Sheet1.Range("C1") & ".xlsx"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & rsFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
sheetName = GetSheetName(rsFile)
rsSQL = "SELECT * FROM [" & sheetName & "]"
Set rsData = New ADODB.Recordset
rsData.Open rsSQL, strConn, , adOpenUnspecified, adLockUnspecified
Sheet1.Range("F4").CopyFromRecordset rsData
End Sub
'return the worksheet name from a closed single-sheet Excel file
Function GetSheetName(fPath As String)
Dim cn As ADODB.Connection
Dim rsT As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & fPath & _
";Extended Properties=Excel 12.0;"
.CursorLocation = adUseClient
.Open
End With
Set rsT = cn.OpenSchema(adSchemaTables)
GetSheetName = rsT.Fields("TABLE_NAME").Value
rsT.Close: Set rsT = Nothing
cn.Close: Set cn = Nothing
End Function
Here's how to use ADOX to query the structure of an Excel workbook:
Sub Tester()
Dim cn As ADODB.Connection
Dim rsT As ADODB.Recordset
Dim intTblCnt As Integer, intTblFlds As Integer
Dim strTbl As String
Dim rsC As ADODB.Recordset
Dim intColCnt As Integer, intColFlds As Integer
Dim strCol As String
Dim t As Integer, c As Integer, f As Integer
Set cn = New ADODB.Connection
With cn
'edit: updated to work with .xlsx-format files
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & _
"\ADOXSource.xlsx;Extended Properties=Excel 12.0;"
.CursorLocation = adUseClient
.Open
End With
Set rsT = cn.OpenSchema(adSchemaTables)
intTblCnt = rsT.RecordCount
intTblFlds = rsT.Fields.Count
Debug.Print "Tables: " & intTblCnt
Debug.Print "--------------------"
For t = 1 To intTblCnt
strTbl = rsT.Fields("TABLE_NAME").Value
Debug.Print vbTab & "Table #" & t & ": " & strTbl
Debug.Print vbTab & "--------------------"
For f = 0 To intTblFlds - 1
Debug.Print vbTab & rsT.Fields(f).Name & _
vbTab & rsT.Fields(f).Value
Next
Debug.Print "--------------------"
Set rsC = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, strTbl, Empty))
intColCnt = rsC.RecordCount
intColFlds = rsC.Fields.Count
For c = 1 To intColCnt
strCol = rsC.Fields("COLUMN_NAME").Value
Debug.Print vbTab & vbTab & "Column #" & c & ": " & strCol
Debug.Print vbTab & vbTab & "--------------------"
For f = 0 To intColFlds - 1
Debug.Print vbTab & vbTab & rsC.Fields(f).Name & _
vbTab & rsC.Fields(f).Value
Next
Debug.Print vbTab & vbTab & "--------------------"
rsC.MoveNext
Next
rsC.Close
Debug.Print "--------------------"
rsT.MoveNext
Next
rsT.Close
cn.Close
End Sub
My original issue was caused by not noticing that there was a space after a certain string. Simple as that but took me some time to figure that out. Thank you all for your valuable inputs!
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
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.
I am trying to populate a combobox in Excel file with data from SQL Server.
Here is code for event:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("Generation").Activate
Set cn = New ADODB.Connection
On Error Resume Next
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User" & _
"Password = " & "server123"
.Open
End With
Set rs = New ADODB.Recordset
sqltextexec = " SELECT name FROM sys.tables WHERE schema_id = 7 AND name LIKE 'FinalCalculated%' ORDER BY create_date "
rs.Open sqltextexec, cn
rs.MoveFirst
With Sheets("Generation").ComboBox1
.Clear
Do
.AddItem rs![Name]
rs.MoveNext
Loop Until rs.EOF
End With
End Sub
This code works on my computer and on my colleague's as well (we are from DB team) but analysts who don't work with DB don't get list populated in the file.
Is it possible the program uses Windows authentication to connect to the DB?
Connection String Error
It seems there is an error in your connection string. The user ID needs to have a semi-colon after it.
Change this
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User" & _
"Password = " & "server123"
To this
With cn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Integrated Security=SSPI;" & _
"Server=" & "192.160.160.150;" & _
"Database=" & "em_Consumer;" & _
"User Id= " & "User;" & _
"Password = " & "server123"
That was an elusive little bugger.
Edit
I'm having trouble pinpointing the issue here, so perhaps a working example will better assist you at this point...
Function getSqlData(queryString As String, myUsername As String, myPassword As String, database As String) As Recordset
Dim conn As New ADODB.Connection
Dim rst As Recordset
Dim serverName As String
serverName = "192.160.160.150"
With conn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Data Source=" & serverName & ";" & _
"Initial Catalog=" & database & ";User Id=" & myUsername & ";" & _
"Password=" & myPassword & ";Trusted_Connection=no"
.Open
End With
Set rst = conn.Execute(queryString)
Set getSqlData= rst
End Function
This will return your recordset.
today I tried to write it from scratch using #lopsided help. Here is the code:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("generation").Activate
Dim rstt As Recordset
MsgBox "1"
Set rstt = getData()
End Sub
-------------------------------------------------
Private Function getData()
Dim conn As New Connection
Dim rst As Recordset
Dim sqlstring As String
Dim rwcnt As Integer
MsgBox "2"
sqlstring = "SELECT productname FROM dbo.products WHERE recalc = 1"
With conn
.ConnectionString = "Provider=SQLOLEDB.1;" & _
"Data Source=192.160.160.150;" & _
"Initial Catalog=em_Consumer;" & _
"User Id=User;" & _
"Password=server!;" & _
"Trusted_Connection=no"
.Open
End With
MsgBox "3"
Set rst = conn.Execute(sqlstring)
rwcnt = rst.RecordCount
MsgBox rwcnt
MsgBox "5"
Set getData = rst
MsgBox "6"
End Function
So when i open the file I get messages:
1 which means that program started;
2 which means that it entered the function;
3 which means that there is no issues with connection;
!! then I get -1 value as record count which means that something is wrong
I tried to run this query in management studio and it returns 50 rows
Then program goes further and I get 5 and 6 ...
Do you have any ideas what is wrong with the code?
---------------------------------------------
Maybe it can help, code which works fine but returns table not recordset in the same document:
Sub Button3_Click()
ActiveSheet.Cells.Clear
Dim qt As QueryTable
sqlstring1 = "SELECT * FROM dbo.Report"
With ActiveSheet.QueryTables.Add(Connection:=getConnectionStr2, Destination:=Range("A3"), Sql:=sqlstring1)
.Refresh
End With
End Sub
----------------------------------
Private Function getConnectionStr2()
'DRIVER={SQL Server};
getConnectionStr2 = "ODBC;DRIVER={SQL Server};" & _
"DATABASE=em_Consumer;" & _
"SERVER=192.160.160.150;" & _
"UID=user;" & _
"PWD=server!;"
End Function