How to populate Excel ComboBox with data from SQL Server? - sql

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

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 Offset with Excel SQL query

I'm working on an excel file to collect information from others closed Excel files
The provider is Microsoft.ACE.OLEDB.12.0 and everything works fine (almost).
In order to have updateable query, I used the command HDR = no in order to have column name like F1, F2, F3... and I retrieve the name after (see the code below, code from Stack Overflow).
However, with the command Union All, I also retrieved the headers as data, if I collect data from 5 files, I'll get 5 headers.
So I'm looking for a solution to retrieve header with command HDR = NO on Excel SQL query (start at line 2 in each file).
I tried OFFSET command in SQL query but I get an error message.
I also tried to get the row number in the original file but I didn't find the command.
Do you have any idea to help me on this issue?
Many thanks in advance,
BR
Code for information:
Option Explicit
Sub SqlUnionTest()
Dim strConnection As String
Dim strQuery As String
Dim objConnection As Object
Dim objRecordSet As Object
strConnection = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"User ID=Admin;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Mode=Read;" & _
"Extended Properties=""Excel 12.0 Macro;"";"
strQuery = _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source1.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"UNION " & _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source2.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"UNION " & _
"SELECT * FROM [Sheet1$] " & _
"IN '" & ThisWorkbook.Path & "\Source3.xlsx' " & _
"[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=NO;'] " & _
"ORDER BY ContactName;"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
Set objRecordSet = objConnection.Execute(strQuery)
RecordSetToWorksheet Sheets(1), objRecordSet
objConnection.Close
End Sub
Sub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)
Dim i As Long
With objSheet
.Cells.Delete
For i = 1 To objRecordSet.Fields.Count
.Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset objRecordSet
.Cells.Columns.AutoFit
End With
End Sub
You can specify the starting and ending row while querying the excel file. So Instead of -
SELECT * FROM [Sheet1$]
Use This -
SELECT * FROM [Sheet1$A2:end]
A2 - it will start reading from 2nd row.
end - will read until the sheet has data. So suppose, if you want to only some rows from SHEET1. Use this -
SELECT * FROM [Sheet1$A2:A10]

unable to connect to oracle11g db using ADODB

I am trying to validate data in the oracle DB using ADODB. I installed the Oracle Client x64 bit and configured the environment variables correctly. For some reason, the below code throws automation error which is not very helpful to narrow down the problem.
PS: I also tried the same by installing the 32 bit version of the oracle client.
Sub test()
myHost = ""
Database_Name = ""
myUsername = ""
myPassword = ""
serviceID = ""
myPort = ""
strConnectionString = "Driver={Oracle in OraClient11g_home1}; " & _
"SERVER=(DESCRIPTION=" & _
"(ADDRESS=(PROTOCOL=TCP)" & _
"(HOST=" & myHost & ")(PORT=" & myPort & "))" & _
"(CONNECT_DATA=(SERVICE_NAME=" & serviceID & "))); uid=" & myUsername & ";pwd=" & myPassword & ";"
Debug.Print strConnectionString
'Instantiate the Connection object and open a database connection.
Set cnn = CreateObject("ADODB.Connection")
cnn.Open strConnectionString
'Above line throws error
End Sub
Error Message
*
Microsoft Visual Basic for Applications
Run-time error '-2147217843 (80040e4d)': Automation error OK Help
*
Thought of reaching out to experts support.
I couldn't get that working with Oracle in OraClient11g_home1 driver. So I installed 32 bit Microsoft ODBC for Oracle and got the job done.
Set objCon = CreateObject("ADODB.Connection")
Set objRec = CreateObject("ADODB.RecordSet")
Dim fieldName, fieldValue
Dim host_name: host_name = ""
Dim service_name: service_name = ""
Dim user_name : user_name = ""
Dim pass : pass = ""
Dim strSQL : strSQL = ""
Dim data_array
data_array = Array("","","")
conStr = "Driver={Microsoft ODBC for Oracle};Server=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)(HOST=" & host_name & ")(PORT=1525))(CONNECT_DATA=(SERVICE_NAME=" & service_name & "))); Uid=" & user_name & ";Pwd=" & pass &";"
objCon.Open conStr
objRec.Open strSQL, objCon
Set objFields = objRec.Fields
Do Until objRec.EOF
For intLoop = 0 To (objFields.Count - 1)
fieldName = objFields.Item(intLoop).Name
fieldValue = objFields.Item(intLoop).Value
If Cstr(fieldValue) = Cstr(data_arr(intLoop)) Then
Debug.print "Check value of " & fieldName & " Value of " & fieldName & " in DB " & fieldValue & " is same as application " & data_arr(intLoop)
Else
Debug.print "Check value of " & fieldName & " Value of " & fieldName & " in DB " & fieldValue & " is not same as application " & data_arr(intLoop)
End If
Next
objRec.MoveNext
Loop
objRec.Close
objCon.Close

VBA sheet1$ error message

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!

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"