I am trying to read the contents of two different tabs in a worksheet and compare them by using ADODB and querying techniques VBA.
Below you can find my code:
stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & wbBook.FullName & ";" _
& "Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;Readonly = False"";"
' MsgBox (stCon)
'here is SQL code to gather data including our calculation from two tables within the workbook
'stSQL = "SELECT [Recon_Daily_Xml_report$].RECTYPEGLEDGER, [GL_Activity_totals$].TRXNTYPE, ([Recon_Daily_Xml_report$].Amount_Abs - [GL_Activity_totals$].BILLINGAMT) as Amount_Diff ,"
'stSQL = stSQL & " ([Recon_Daily_Xml_report$].NUMOFENTRIES - [GL_Activity_totals$].NUMOFTRXNS) as Count_Diff "
'stSQL = stSQL & " FROM [Recon_Daily_Xml_report$], [GL_Activity_totals$]"
'stSQL = stSQL & " WHERE Lower([Recon_Daily_Xml_report$].RECTYPEGLEDGER) = Lower([GL_Activity_totals$].TRXNTYPE)"
'stSQL = stSQL & " ORDER BY [Recon_Daily_Xml_report$].RECTYPEGLEDGER ASC"
stSQL = "SELECT LCASE([GL_Activity_totals$].TRXNTYPE),Sum(ABS([GL_Activity_totals$].BILLINGAMT)),Sum([GL_Activity_totals$].NUMOFTRXNS) "
stSQL = stSQL & " FROM [GL_Activity_totals$] "
stSQL = stSQL & " Group By [GL_Activity_totals$].TRXNTYPE "
stSQL = stSQL & " ORDER BY [GL_Activity_totals$].TRXNTYPE ASC"
'MsgBox (stSQL)
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
cnt.Open stCon
'rst.Open stSQL, cnt, 1, 3
rst.Open stSQL, cnt, adOpenStatic, adLockOptimistic
'rst.Open strSQL, cnt, adOpenStatic, adLockOptimistic
With rst
Do While Not .EOF
If rst.Fields.Item(0).Value <> "" Then
strString = Replace(rst.Fields.Item(0).Value, " ", " ")
rst.Update
rst.Fields.Item(0) = strString
End If
.MoveNext
Loop
End With
This specific code gives me back an error suggesting that I cannot update the field in the recordset I want to update when reading it. The error I am currently getting is:
Run-time error '-2147217911 Cannot update. Database or object is read-only.
Tried to change the way i open the recordset by using 1,3 option but again i was getting the same error.
Can anyone help with this?
The issue is with
LCASE([GL_Activity_totals$].TRXNTYPE)
and with the GROUP BY.
In this case, rst.Fields.Item(0) is an expression, not a table value. You can't update expressions. Also, since you're using GROUP BY, the recordset is not linked to any particular record for access to edit. You could accomplish the same task purely in SQL
cnt.Execute("UPDATE [GL_Activity_totals$] " & _
" SET [GL_Activity_totals$].TRXNTYPE = Substitute([GL_Activity_totals$].TRXNTYPE,' ', ' ') " & _
" WHERE NOT [GL_Activity_totals$].TRXNTYPE IS NULL " & _
" AND [GL_Activity_totals$].TRXNTYPE <> '';")
Related
My query works fine outside of the loop when I have the hard-coded values in. When I put the query inside my loop and use variables to hold the correct values it returns EOF. I've printed out the query and run it directly in SQL server and it returns the correct results. Which makes me think my SQL syntax is ok, but I can't figure out why it doesn't return anything in the loop. Any Ideas?
Public Function getPOs()
Dim TotalPos, Curpo, Query, ClaimNum, Color, DCloc As String
Dim i As Integer
Dim Row, Style, LastRow As LongPtr
Dim ws As Worksheet
Set ws = Worksheets("test")
' Set up database connection
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = New ADODB.Connection
cnn.ConnectionString = SQL_SERVER_CONNECTION
cnn.ConnectionTimeout = 0
cnn.CommandTimeout = 0
cnn.Open
'This query works fine, it returns results that I can iterate through.
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = '1337' AND STYLE = '293493' and COLOR = '03' AND DC_LOCATION = 'PFC'", cnn, adOpenDynamic, adLockOptimistic
' Itereate through the results
i = 0
Do While Not rs.EOF
If rs![PO] = "" Then
Exit Do
End If
If i = 0 Then
Curpo = rs![PO]
TotalPos = Curpo
Else
Curpo = rs![PO]
TotalPos = TotalPos & ", " & Curpo
End If
i = i + 1
rs.MoveNext
Loop
MsgBox TotalPos ' Works fine!
' For some reason adding the query inside this loop messes it up.
Row = 11
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
rs.Close
While Row < 12 ' will change back to LastRow once working
'Parse the claim number
ClaimNum = Replace(ws.Cells(Row, 10), "IC - ", "")
MsgBox ClaimNum
'Style
Style = Left(ws.Cells(Row, 11), Len(ws.Cells(Row, 11)) - 2)
MsgBox Style
'Color
Color = ws.Cells(Row, 12)
MsgBox Color
'DCloc
DCloc = ws.Cells(Row, 13)
MsgBox DCloc
' When I add the query here it returns nothing...
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = ' " & DCloc & "'", cnn, adOpenDynamic, adLockOptimistic
'add the entire sql statement to the Query var so I can print it out and run it in SQL Server
Query = "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = '" & DCloc & "'"
' print the query... when I run this exact thing in SQL server it returns results just fine'
MsgBox Query
' iterate through results
i = 0
'rs.EOF now that it's in the loop... but why? I know the syntax of the query is correct, it returns results when I run it directly in SQL server
If rs.EOF Then
MsgBox "why???"
End If
Do While Not rs.EOF
If rs![PO] = "" Then
Exit Do
End If
If i = 0 Then
Curpo = rs![PO]
TotalPos = Curpo
Else
Curpo = rs![PO]
TotalPos = TotalPos & ", " & Curpo
End If
MsgBox TotalPos
i = i + 1
rs.MoveNext
Loop
rs.Close
Row = Row + 1
Wend
cnn.Close
End Function
rs.Open "SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = " & ClaimNum & " AND STYLE = " & Style & " and COLOR = '" & Color & "' AND DC_LOCATION = ' " & DCloc & "'"
Don't concatenate parameter values into your SQL string - that way you don't need to care about quoting strings and worry about whether a string contains apostrophes, or worse - the widely-known tale of Little Bobby Tables captures just how impactful this careless value concatenation practice can be, if you let it.
Instead, define your query once, and let the server deal with the parameters (it's its job).
Const sql As String = _
"SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = ? AND STYLE = ? AND COLOR = ? AND DC_LOCATION = ?"
Each ? is understood by ADODB as a positional parameter: all you need to do now, is to execute a ADODB.Command with 4 parameters, appended in the order they are specified.
Now you can write a Function that takes the values for the 4 parameters you need, and the function can return a ADODB.Recordset that contains the results - no need to redefine the SQL string every time you need it!
Private Function GetPO(ByVal cnn As ADODB.Connection, ByVal ClaimNum As String, ByVal Style As String, ByVal Color As String, ByVal DCloc As String) As ADODB.Recordset
Const sql As String = _
"SELECT PO " & _
"FROM [catalog].[dbo].[table] " & _
"WHERE CLAIM_NUMBER = ? AND STYLE = ? AND COLOR = ? AND DC_LOCATION = ?"
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = sql
'TODO: verify parameter types & sizes - here NVARCHAR(200).
'NOTE: parameters must be added in the order they are specified in the SQL.
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=ClaimNum)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=Style)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=Color)
cmd.Parameters.Append cmd.CreateParameter(Type:=adVarWChar, Size:=200, Value:=DCloc)
Set GetPO = cmd.Execute
End Function
You can use it from anywhere you have an ADODB.Connection that's ready to use:
Dim rs As ADODB.Recordset
Set rs = GetPO(cnn, ClaimNum, Style, Color, DCloc)
Do While Not rs.EOF
'...
Loop
You need to wrap variables in quotes to make it work, a string type isn't enough.
"WHERE CLAIM_NUMBER = " & ClaimNum & " ...
Needs to become:
"WHERE CLAIM_NUMBER = " & "'" & ClaimNum & "'" & " ...
In addition to all the other variables you are concatenating into the SQL statement
As an aside
Dim TotalPos, Curpo, Query, ClaimNum, Color, DCloc As String
is only declaring DCloc as a string and all the others are variants.
To make them all string you need to add as string to all of them.
Dim TotalPos as string, Curpo as string, Query as string, ClaimNum as string, Color as string, DCloc As String
I am using Excel 2013 as a front end application written w/ VBA.
I've linked a XLSX file inside an Access 2013 database in order to use SQL simply for example to read MAX Value of a column of which datas are filtered with a Where Clause.
I cannot understand why a SQL statement for retrieving MAX value does not work whereas the same statement is OK via SQL Querying in Access.
Hereafter VBA code excerpt :
varCnxStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" &
G_sWBookREINVOICingFilePath & ";Mode="
With conXLdb
'*
'.Provider = "Microsoft.ACE.OLEDB.12.0"
'.ConnectionString = "Data Source=" & G_sWBookREINVOICingFilePath & ";"
& "Extended Properties='Excel 12.0;HDR = YES'"
'.Mode = adModeShareExclusive
.Open varCnxStr & adModeShareExclusive
'*
End With
Debug.Print varCnxStr & adModeShareExclusive
strSQL = "SELECT MAX(InvoiceNum) as LastNumInvoice"
strSQL = strSQL & " FROM ReInvoiceDB "
strSQL = strSQL & " WHERE InvoiceNum > " & strYMPrefix_p & "000"
strSQL = strSQL & ";"
Debug.Print strSQL
adoXLrst.Open Source:=strSQL, ActiveConnection:=conXLdb,
CursorType:=adOpenStatic, LockType:=adLockOptimistic, Options:=adCmdText
adoXLrst.MoveFirst
'Set adoXLrst = conXLdb.Execute(strSQL)
HighestStr = adoXLrst![LastNumInvoice]
adoXLrst.Close
strGSFNumber = HighestStr '>> byref returning value
conXLdb.Close
Veloma:
'>>
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
'>>
Diso:
Beep
Beep
'>>
strGSFNumber = "ERR"
'>>
sMsg = "pG_getNEXTInvoiceValueXLasDB-ERR ::" & Err.Number & ":: - " &
Err.Description
MsgBox sMsg, vbOKOnly + vbCritical
sRet = sMsg
Resume Veloma
End Sub
It returns Null value in variable HighestStr whereas it should receive a double value ...
Any help or any clue on misfunctionning ?
Regards.
I'm trying to use DCount to see if records exist in a table before inserting the data into the database but I keep getting a type mismatch error on "Customer Number" and have no idea why. The code is below:
Public Sub ExportData()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\PRID.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO [Investment Data] ([Customer Number])"
ssql = ssql & "SELECT [Customer Number] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
If Application.WorksheetFunction.DCount("Customer Number", "Investment Data", "[Customer Number]=" & Range("A2")) > 0 Then
MsgBox ("A similar entry has been detected within the PRID database, please make sure that this is a new entry before you continue.")
Else
MsgBox ("Entry has been entered into the database.")
cn.Execute ssql
Exit Sub
End If
Any help would be appreciated thanks.
This should resolve your problem
You can add a WHERE clause to your query that will skip the [Customer Number] that already exists in the [Investment Data] table.
ssql = ssql & _
" WHERE [Customer Number] NOT IN(SELECT [Customer Number] FROM [Investment Data]);)"
You can then use Connection.Execute to return the number of records added.
Results = cN.Execute(ssql)
MsgBox Results & " Records were added " & (allRecordsCount - Results) & "Records Were Skipped"
If you want to alert the user before you insert the records you'll need two queries.
ssql = ssql & "SELECT [Customer Number] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh & _
ssql & " WHERE [Customer Number] IN(SELECT [Customer Number] FROM [Investment Data]);)"
Set rs = CreateObject("ADODB.Recordset")
Set rs = cN.Execute(ssql)
If Not rs.BOF AND Not rs.EOF Then
msg = msg & vbCrLf & rs.Fields("Customer Number").Value
rs.MoveNext
End If
If msg <> "" Then
MsgBox "These Records Are Duplicates" & vbCrLf & msg
Exit Sub
End If
This should answer your question
You are getting the "DCount Type Mismatch Error VBA" because you are trying to query an external Access Database using the Excel WorksheetFunction DCount.
Test Queries
Public Sub TestQueries()
Set cN = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
dbPath = Application.ActiveWorkbook.path & "\PRID.mdb"
'dbPath = "C:\Users\best buy\Downloads\stackoverfow\Sample Data File\test.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cN.Open scn
ssql = ssql & "SELECT [Customer Number] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Set rs = cN.Execute(ssql)
Do While Not rs.BOF And Not rs.EOF
msg = msg & vbCrLf & rs.FIelds(0).Value
rs.MoveNext
Loop
MsgBox msg, vbInformation, "Results Query Without Where Clause"
ssql = ssql & _
" WHERE [Customer Number] IN(SELECT CDbl([Customer Number]) FROM [Investment Data])"
msg = ""
Set rs = cN.Execute(ssql)
Do While Not rs.BOF And Not rs.EOF
msg = msg & vbCrLf & rs.FIelds(0).Value
rs.MoveNext
Loop
MsgBox msg, vbInformation, "Results Query With Where Clause"
End Sub
I am trying to extract the data with ADODB connection through VBA but when i run throgh this code recset.Open strSQL, con, adOpenKeyset, adLockOptimistic
my excel is automatically getting closed.
Is there anything which i am missing?
Sub Show_data()
Dim con As ADODB.Connection
Dim recset As ADODB.Recordset
Dim ConnectionString As String
Dim strSQL As String
Set con = New ADODB.Connection
Set recset = New ADODB.Recordset
'Check for the connectivity or connected to the xx network
On Error GoTo errHandler
errHandler:
If Err.Number = -2147467259 Then
MsgBox "Please check for the xx connectivity ", vbExclamation + vbOKOnly
Exit Sub
End If
ConnectionString = "Provider=MSDASQL;User ID=myuser;password= mypass;Data Source=mys"
con.Open ConnectionString
'Set and Excecute SQL Command'
strSQL = "SELECT B.USER_NAME AS CREATED_BY, A.CREATION_DATE, C.USER_NAME, A.LAST_UPDATE_DATE, A.PFIZER_ITEMCODE, A.SYSTEM_ITEMCODE AS ORACLE_ITEM_CODE, " & _
"A.ITEM_DESCRIPTION, A.BATCH_NUMBER, A.MFR_CODE, A.MFR_DESC AS MFR_DESCRIPTION, TO_CHAR(A.MFR_DATE,'DD-MON-YYYY')As MFR_DATE, TO_CHAR(A.EXPIRY_DATE,'DD-MON-YYYY')As EXPIRY_DATE, " & _
"TO_CHAR(A.EFFECTIVE_FROM,'DD-MON-YYYY') AS EFFECTIVE_FROM, " & _
"A.EFFECTIVE_TO, A.EXCISE AS EXCISE_AMOUNT, A.EXCISE_RATE, A.P2S, A.P2R, A.MRP, A.STATE_CODE, A.STATE, " & _
"(CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )AS LEGAL_ENTITY " & _
"FROM xxdhl_pf_batch_pricing A JOIN fnd_user B ON A.CREATED_BY = B.USER_ID " & _
"JOIN fnd_user C ON A.LAST_UPDATED_BY = C.USER_ID WHERE "
If (ActiveSheet.cmbLE.Text) <> "" Then
strSQL = strSQL & " (CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )='" & ActiveSheet.cmbLE.Text & "'"
End If
If (ActiveSheet.cmbProduct.Text) <> "" Then
If (ActiveSheet.cmbLE.Text) <> "" Then
strSQL = strSQL & " AND A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
Else
strSQL = strSQL & " A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
End If
End If
If (ActiveSheet.txtBatch.Text) <> "" Then
If (ActiveSheet.cmbLE.Text) <> "" Or (ActiveSheet.cmbProduct.Text) <> "" Then
strSQL = strSQL & " AND A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
Else
strSQL = strSQL & " A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
End If
End If
'Open Recordset
Set recset.ActiveConnection = con
recset.Open strSQL, con, adOpenKeyset, adLockOptimistic
'Copy the data
If recset.RecordCount > 0 Then
Sheets("Sheet2").Range("A2").CopyFromRecordset recset
Else
MsgBox "No Data Available", vbExclamation + vbOKOnly
Exit Sub
End If
recset.Close
con.Close
End Sub
The issue may be with your connection's cursor location, by default it is adUseServer. When using keyset, you will probably want to use adUseClient. I know from using ms access that this is especially the case when attempting to bind the recordset to a form. Try opening the connection with adUseClient, hopefully it will resolve your issue.
I am working MS Excel-2010.I have an excel sheet like below:
Process# requirementrcvd designdate codingdate test1 date test2 date deliverdate
11 10/11/2009 12/12/2009 02/02/2011 02/03/2011 09/03/2011 10/04/2011
12 10/11/2010 12/12/2011 15/02/2012
13 10/11/2009 12/12/2009 02/02/2011 02/03/2011
Where all the dates are given in increasing value.But I am trying to get some ADODB functionality by which I can set the date values which are null to something greater than that record's last column date.
Say, as an exmple process#12 test1 date,test2 date,delivery date areNULL,so by .vbs script it should be set to 16/02/2012,17/02/2012,18/02/2012.
CODE:
Option Explicit
Dim conn, cmd, rs
Dim clauses(34), i
Dim xlApp, xlBook
Dim tempDate,LenDate
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""D:\AravoVB\Final Scripts\GE_Wing_To_Wing_Report - Copy.xlsx"";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"""
.Open
End With
'tempDate=""
For i = 0 To 34
clauses(i) = "IIf(IsNull([Task" & i + 1 & " Start Date]),Date()+"& i &",[Task" & i + 1 & " Start Date]) < IIf(IsNull([Task" & i + 2 & " Start Date]),Date()+"& i &",[Task" & i + 2 & " Start Date])"
tempDate=tempDate & "NVL([Task" & i + 1 & " Start Date],Date()+"& i &"),"
Next
'LenDate=Len(tempDate)-1
'tempDate=Mid(tempDate,1,LenDate)
MsgBox(tempDate)
Set cmd = CreateObject("ADODB.Command")
cmd.CommandText = "SELECT * FROM [GEWingToWingMay25$] WHERE [Business Process ID] NOT IN (" & "SELECT [Business Process ID] FROM [GEWingToWingMay25$] WHERE " & Join(clauses, " OR ") & ")"
MsgBox(cmd.CommandText)
cmd.ActiveConnection = conn
Set rs = cmd.Execute
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
xlBook.Sheets(1).Range("A1").CopyFromRecordset cmd.Execute
'xlBook.Sheets(1).Cells(1,25).Value=cmd.CommandText
You need an UPDATE statement instead of a SELECT statement. Specifcally something like this:
cmd.CommandText = _
"UPDATE [GEWingToWingMay25$] " & _
"SET [Task1 Start Date] = Now() " & _
"WHERE [Business Process ID] NOT IN (" & _
"SELECT [Business Process ID] " & _
"FROM [GEWingToWingMay25$] " & _
"WHERE " & Join(clauses, " OR ") &
")"