I am trying to connection sqlserver from VBA program, I refer to the following code to achieve it, but I
got the problem: connection failed. Any help. Thank you in advance.
Code:
Sub ADOExcelSQLServer()
' Carl SQL Server Connection
'
' FOR THIS CODE TO WORK
' In VBE you need to go Tools References and check Microsoft Active X
'Data Objects 2.x library
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "EXCEL-PC\EXCELDEVELOPER" ' Enter your server name here
Database_Name = "AdventureWorksLT2012" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM [SalesLT].[Customer]" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
With Worksheets("sheet1").Range("a1:z500") ' Enter your sheet name and range here
.ClearContents
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
test this.
Sub cn()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim i As Integer
con.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Server=(local);" _
& "Database=AdventureWorksLT2012;" _
& "Integrated Security=SSPI;" _
& "DataTypeCompatibility=80;"
con.Open
Set cmd.ActiveConnection = con
cmd.CommandText = "SELECT * FROM [SalesLT].[Customer]"
Set rst = cmd.Execute
Range("A1").CopyFromRecordset rst
con.Close
Set con = Nothing
End Sub
I checked your code and it works for me. So I think it should be a SQL configuration problem e.g. permissions or port issue. You need to test connection status by using sqlserver client and check related connection problem.
Related
I've a below VBA code and I want to read four values a, b, c, d from an excel column (A1:A4) so those can be part of my SQL query IN statement when I connect to database.
I build up the sWHEREclause to create ('a','b','c','d') string that but the final SQL query SQLStr seems to have some error and my code fails.
Can someone please help.
Thank you so much in advance.
Sub ADOExcelSQLServer()
Dim Cn As ADODB.Connection 'connection variable
Dim Server_Name As String ' text type
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset ' Database connection variable
Dim rRange As Range
Dim rCell As Range
Dim sWHEREclause As String
Set rs = New ADODB.Recordset
Server_Name = "server name"
Database_Name = "Database name"
Set rRange = Sheet1.Range("A1:A4")
For Each rCell In rRange
sWHEREclause = sWHEREclause & "'" & rCell & "',"
Next rCell
'SQLStr = "Select * from MASTER_QUERY mq where mq.ModelNum in ('a','b','c','d')" 'commented line
SQLStr = "Select * from MASTER_QUERY mq where mq.ModelNum IN (" & sWHEREclause & ")"
Set Cn = New ADODB.Connection 'set connection with databse
Cn.Open "Provider=SQLOLEDB;Data Source=" & Server_Name & "; Initial Catalog=" & Database_Name & "; Integrated Security=SSPI;" 'connection parameter to the database
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
With Worksheets("sheet1").Range("b2:z500") ' Enter your sheet name and range here
' Range(A1).Value = "ID)"
.ClearContents ' clear content first in excel
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Your string ends with a ,
do your loop like this:
Dim delim as string
delim = ""
For Each rCell In rRange
sWHEREclause = sWHEREclause & delim & "'" & rCell & "'"
delim = ", "
Next rCell
I created an Excel file with 3 worksheets like this:
My goal is: making the worksheets accessible only with a password. That means you can see the content of the worksheet only with a password.
For Example: When the "User" clicks on "Admin", the content of the worksheet is only visible after entering the right password.
Worksheet protect is useless.
Is it possible ?
There is no possibility to securely protect one sheet only from viewing. You can only protect a whole workbook from viewing (with password).
Any workaround you try to securely hide/protect a sheet with password can easily be tricked out by any user.
The only way to securely hide data from users is not to hand out this data at all. The only really secure way is to have something like a client server process where the server has the raw data, the client sends a request to that server, and the server only sends the data the user is allowed to see.
Try following codes.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheetName As String
MySheetName = "Admin1" 'The sheed name which you want to hide.
If Application.ActiveSheet.Name = MySheetName Then
Application.EnableEvents = False
Application.ActiveSheet.Visible = False
response = Application.InputBox("Password", "Enter Password", , Type:=2)
If response = "rainy2019" Then 'Unhide Password.
Application.Sheets(MySheetName).Visible = True
Application.Sheets(MySheetName).Select
End If
End If
Application.Sheets(MySheetName).Visible = True
Application.EnableEvents = True
End Sub
VBA Window:
How about this ADO solution?!
Add Reference: Microsoft ActiveX Data Objects 2.8 Library
Sub test()
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbPath As String
Dim aQuery As String
Dim pword As String
Dim strcon As String
dbPath = ThisWorkbook.Path & "\Database.mdb"
pword = "abcd"
aQuery = "SELECT * FROM myTable"
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & dbPath & ";" _
& "Jet OLEDB:Database Password=" & pword & ";"
Conn.Open strcon
rs.Open aQuery, Conn
If Not (rs.EOF And rs.BOF) Then
MsgBox rs.Fields(0)
End If
rs.Close
Set rs = Nothing
Set Conn = Nothing
End Sub
Or, use a DAO solution.
Add Reference: Microsoft DAO 3.6 Object Library
Sub test()
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbPath As String
Dim aQuery As String
Dim pword As String
Dim strcon As String
dbPath = ThisWorkbook.Path & "\Database.mdb"
pword = "abcd"
aQuery = "SELECT * FROM myTable"
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & dbPath & ";" _
& "Jet OLEDB:Database Password=" & pword & ";"
Conn.Open strcon
rs.Open aQuery, Conn
If Not (rs.EOF And rs.BOF) Then
MsgBox rs.Fields(0)
End If
rs.Close
Set rs = Nothing
Set Conn = Nothing
End Sub
I want to import data from 2 columns in SQL server, im following this code from http://buffalobi.com/excel/excel-vba-import-sql-server-data/, whats wrong?
Private Sub CommandButton2_Click()
Call CommandButton1_Click
Dim conn As New ADODB.Connection, cmd As New ADODB.Command, rs As New ADODB.Recordset
With conn
.ConnectionString = _
"Provider = Microsoft.ACE.OLEDB.12.0; " & _
"data source=localhost; " & _
"initial catalog=PTrails_Core_DB;" & _
"integrated security=True;"
.Open
End With
and i get this message
I would set 'ConnectionString' as variable and use that to open. If this doesn't work, it would have to be the actual link you're referring to that's causing an issue. Maybe because it's ending on semicolon.
Dim ConnectionString as String
ConnectionString = "Provider = Microsoft.ACE.OLEDB.12.0;data source=localhost;initial catalog=PTrails_Core_DB;integrated security=True"
conn.Open ConnectionString
This will do what you want.
Sub ImportFromSQLServer()
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset
Server_Name = "your_server_name"
Database_Name = "Northwind"
'User_ID = "******"
'Password = "****"
SQLStr = "select Field1, Field2 from dbo.TBL" 'and PostingDate = '2006-06-08'"
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & ";"
'& ";Uid=" & User_ID & ";Pwd=" & Password & ";"
RS.Open SQLStr, Cn, adOpenStatic
With Worksheets("Sheet1").Range("A1")
.ClearContents
.CopyFromRecordset RS
End With
RS.Close
Set RS = Nothing
Cn.Close
Set Cn = Nothing
End Sub
the macro below exports data to SQL tables, when the name of the table has no space, it works perfectly, but if the name has a space, it blocks,
it blocks on the rs.Open line tableName, Cn, adOpenKeyset, adLockOptimistic
I tried the hooks [...] the apostrophe '...' and ... but nothing works
`
Sub Injection()
Dim Cn As ADODB.connection
Dim ServerName As String
Dim DatabaseName As String
Dim tableName As String
Dim UserID As String
Dim Password As String
Dim rs As ADODB.recordset
ServerName = "vmalsdisdb"
DatabaseName = "Produits"
tableName = "PRELEVEMENT PRODUIT"
UserID = ""
Password = ""
Set rs = New ADODB.recordset
Set Cn = New ADODB.connection
Cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & _
";Uid=" & UserID & ";Pwd=" & Password & ";"
rs.Open tableName, Cn, adOpenKeyset, adLockOptimistic`
That's weird! It works fine for me in my test scenario!
Sub ADOExcelSQLServer()
'
' FOR THIS CODE TO WORK
' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
'
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "EXCEL-PC\SQLEXPRESS" ' Enter your server name here
Database_Name = "Test Method" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM [mytable]" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
For iCols = 0 To rs.Fields.Count - 1
Worksheets("Sheet1").Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
With Worksheets("sheet1").Range("a2:z500") ' Enter your sheet name and range here
'.ClearContents
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
I suppose you can try triple quotes around any 'weird' naming conventions, like spaces in names, or special characters in names.
thank you all for your answers, the problem was not worry in space but in one of the Tables, I was able to bypass the problem by replacing the cursor type "adOpenKeyset" by "adOpenDynamic"
but his understanding the problem, may be that another user worked on the table ?!
How to execute a query in MS Access db from Excel VBA code or macro.
MS-Access query accepts some parameters, that needs to be passed from Excel.
Thanks
Here is one possibility:
Dim cn As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
strFile = "C:\docs\Test.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
strSQL = "INSERT INTO ATable (AField) " _
& "VALUES (" & Sheet1.[A1] & ")"
cn.Execute strSQL
cn.Close
Set cn = Nothing
You can also refer in-line in the sql to a dataset from Excel.
EDIT re comments
Using a command:
strSQL = "SELECT * FROM ATable " _
& "WHERE AField = #AField"
With cmd
Set .ActiveConnection = cn
.CommandText = strSQL
.CommandType = 1 'adCmdText
''ADO Datatypes are often very particular
''adSmallInt = 2 ; adParamInput = 1
.Parameters.Append .CreateParameter("#AField", 2, 1, , Sheet1.[A1])
End With
Set rs = cmd.Execute
See also: http://support.microsoft.com/kb/181782
This uses ADODB.
Set m_Connection = New Connection
If Application.Version = "12.0" Then
m_Connection.Provider = "Microsoft.ACE.OLEDB.12.0"
Else
m_Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
End If
m_Connection.Open <full path to Access DB>
If m_Connection.State > 0 Then
Dim rsSource As New Recordset
rsSource.Open strQuery, m_Connection, adOpenForwardOnly, adLockReadOnly
Dim result As Long
Dim rngTarget As Range
rngTarget = ThisWorkbook.Worksheets(m_SheetName).Range("A1")
If Not rsSource.BOF Then
result = rngTarget.CopyFromRecordset(rsSource)
End If
If rsSource.State Then rsSource.Close
Set rsSource = Nothing
End If
So it runs the query and puts it where you like. strQuery is the name of a query in the db or an SQL string.