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
Related
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 & "')"
I need to update a set of values from an Excel Worksheet into a SQL Server Table.
This is the Excel Table:
I wrote some code in VBA to do this, but I'm not very expert.
The update work just fine except for the part where it truncate decimals.
As you can see the decimals get cuts off. The fields on SQL are declared as Decimal (19,5).
Sure there's something wrong in the VBA code. Here's my code.
On Error GoTo RigaErrore
Dim cn_ADO As Object
Dim cmd_ADO As Object
Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DBConn As String
Dim SQLQuery As String
Dim strWhere As String
Dim i As Integer
Dim jOffset As Integer
Dim iStartRow As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'iStep = 100
jOffset = 20
iStartRow = 3
i = iStartRow
SQLUser = "xxxx"
SQLPassword = "xxx"
SQLServer = "xxxxxxxx"
DBName = "xxxxx"
DBConn = "Provider=SQLOLEDB.1;Pesist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
"Data Source=" & SQLServer & ";DataTypeCompatibility=80;"
Set cn_ADO = CreateObject("ADODB.Connection")
cn_ADO.Open DBConn
Set cmd_ADO = CreateObject("ADODB.Command")
While Cells(i, jOffset).Value <> ""
xlsIDKey = Cells(i, 0 + jOffset)
xlsVendSim = CDbl(Cells(i, 1 + jOffset))
xlsOreSim = CDbl(Cells(i, 2 + jOffset))
xlsProdVar = CDbl(Cells(i, 3 + jOffset))
xlsOreSimVar = CDbl(Cells(i, 4 + jOffset))
strWhere = "ID_KEY = '" & xlsIDKey & "'"
SQLQuery = "UPDATE DatiSimulati " & _
"SET " & _
"VEND_SIM = Cast(('" & xlsVendSim & "') as decimal (19,5)), " & _
"ORE_SIM = Cast(('" & xlsOreSim & "') as decimal (19,5)), " & _
"PROD_VAR = Cast(('" & xlsProdVar & "') as decimal (19,5)), " & _
"ORE_SIM_VAR = Cast(('" & xlsOreSimVar & "') as decimal (19,5)) " & _
"WHERE " & strWhere
cmd_ADO.CommandText = SQLQuery
cmd_ADO.ActiveConnection = cn_ADO
cmd_ADO.Execute
i = i + 1
Wend
Set cmd_ADO = Nothing
Set cn_ADO = Nothing
Exit Sub
RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Application.StatusBar = False
Application.Cursor = xlDefault
If Not cn_ADO Is Nothing Then
Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
Set cmd_ADO = Nothing
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Thanks everybody who could help solve this.
A work-around would be to replace the decimal commas with dots.
Option Explicit
Sub connectDB()
Const SQLUser = "#"
Const SQLPassword = "#"
Const SQLServer = "#"
Const DBName = "#"
Dim DBConn As String
DBConn = "Provider=SQLOLEDB.1;Pesist Security Info=True" & _
";User ID=" & SQLUser & ";Password=" & SQLPassword & _
";Initial Catalog=" & DBName & _
";Data Source=" & SQLServer & _
";DataTypeCompatibility=80;"
Dim cn_ADO As Object, cmd_ADO As Object
Set cn_ADO = CreateObject("ADODB.Connection")
cn_ADO.Open DBConn
Set cmd_ADO = CreateObject("ADODB.Command")
cmd_ADO.ActiveConnection = cn_ADO
Const joffset = 20
Const iStartRow = 3
Dim SQLQuery As String, sIDKey As String
Dim sVendSim As String, sOreSim As String
Dim sProdVar As String, sOreSimVar As String
Dim i As Long
i = iStartRow
' create log file
Dim LOGFILE As String
LOGFILE = ThisWorkbook.Path & "\logfile.txt"
Dim fs As Object, ts As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.CreateTextFile(LOGFILE, True)
While Len(Cells(i, joffset).Value) > 0
sIDKey = Cells(i, 0 + joffset)
sVendSim = Replace(Cells(i, 1 + joffset), ",", ".")
sOreSim = Replace(Cells(i, 2 + joffset), ",", ".")
sProdVar = Replace(Cells(i, 3 + joffset), ",", ".")
sOreSimVar = Replace(Cells(i, 4 + joffset), ",", ".")
SQLQuery = "UPDATE DatiSimulati " & _
"SET " & _
"VEND_SIM = " & sVendSim & ", " & _
"ORE_SIM = " & sOreSim & ", " & _
"PROD_VAR = " & sProdVar & ", " & _
"ORE_SIM_VAR = " & sOreSimVar & " " & _
"WHERE ID_KEY = " & sIDKey
ts.writeline SQLQuery & vbCr
cmd_ADO.CommandText = SQLQuery
cmd_ADO.Execute
i = i + 1
Wend
ts.Close
MsgBox i - iStartRow & " records updated see " & LOGFILE, vbInformation
End Sub
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
I have been racking my brain with searching on the internet for the solution, but to no avail, I have been unsuccessful.
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & StrUserName & "', PWD = '" & StrPWD & "', fldPWDDate = '" & Now() & "'" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
Once I get the error out, I would like to actually use this where clause:
'WHERE intLoginPermUserID IN (SELECT intCPIIUserID From vw_ADMIN_Frm_LoginBuilder)
Here is the entire code:
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim strSQL As String
Const cSQLConn = "DRIVER=SQL Server;SERVER=dbswd0027;UID=Mickey01;PWD=Mouse02;DATABASE=Regulatory;"
Dim StrUserName As String, StrPWD As String
'passing variables
StrUserName = FindUserName()
StrPWD = EncryptKey(Me.TxtConPWD)
'Declaring the SQL expression to be executed by the server
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & StrUserName & "', PWD = '" & StrPWD & "', fldPWDDate = '" & Now() & "#" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
'WHERE intLoginPermUserID = ANY (SELECT intCPIIUserID From vw_ADMIN_Frm_LoginBuilder)
Debug.Print strSQL
'connect to SQL Server
Set con = New ADODB.Connection
With con
.ConnectionString = cSQLConn
.Open
End With
'write back
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = strSQL
.CommandType = adCmdText
.Execute
Debug.Print strSQL
End With
'close connections
con.Close
Set cmd = Nothing
Set con = Nothing
MsgBox "You password has been set", vbInformation + vbOKOnly, "New Password"
NEWEST CODE Producing Error:
'/Declaring the SQL expression to be executed by the server
strSQL = "Update dbo_tTbl_LoginPermissions " _
& "SET LoginName = '" & StrUserName & "' " _
& "SET PWD = '" & StrPWD & "' " _
& "SET fldPWDDate = '" & Now() & "' " _
& "WHERE intLoginPermUserID = 3;"
I have gone to this site to try to figure out my mistake, but I still cannot figure it out:
After much dilberation and help, it turns out the FindUserName that utilizes a Win32API function was not trimming the Username appropriately.
I changed it to the following:
Public Function FindUserName() As String
' This procedure uses the Win32API function GetUserName
' to return the name of the user currently logged on to
' this machine. The Declare statement for the API function
' is located in the Declarations section of this module.
Dim strBuffer As String
Dim lngSize As Long
strBuffer = Space$(255)
lngSize = Len(strBuffer)
If GetUserName(strBuffer, lngSize) = 1 Then
FindUserName = Left$(strBuffer, lngSize - 1)
Else
FindUserName = "User Name not available"
End If
End Function
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Try this:
strSQL = "Update tTbl_LoginPermissions SET LoginName = '" & replace(StrUserName, "'", "''") & "', PWD = '" & replace(StrPWD, "'", "''") & "', fldPWDDate = '" & Now() & "'" & _
"WHERE intLoginPermUserID = " & MyMSIDColumn0
This was inevitably the code that corrected my (') mystery:
'/passing variables
StrUserName = FindUserName()
StrPWD = EncryptKey(Me.TxtConPWD)
StrUserId = Me.CboUser.Column(0)
'/Declaring the SQL expression to be executed by the server
strSQL = "Update tTbl_LoginPermissions SET " _
& "LoginName = '" & StrUserName & "' , " _
& "PWD = '" & StrPWD & "' ," _
& "fldPWDDate = '" & Now() & "' " _
& "WHERE intLoginPermUserID = '" & StrUserId & "'"