I am creating a simple spreadsheet which takes an array of IDs from worksheet "input", queries an Oracle database asking for only the records which match the IDs in the array and outputs the results to worksheet "output".
So far, my VBA will work if my array only contains a single ID (by specifying a single cell range), and everything completes with the desired output from the Oracle database appearing in worksheet "output". Good times.
The problem I am having now is that I want to specify a range of IDs (anything up to around 5000) in worksheet "input" to include in my array and pass that array to the Oracle database to return data for each ID it finds (I am not expecting all IDs to exist). Whenever I try this I seem to get "Error 13 Type Mismatch" errors... Bad times.
My VBA code is:
Dim OracleConnection As ADODB.Connection
Dim MosaicRecordSet As ADODB.RecordSet
Dim SQLQuery As String
Dim DBConnect As String
Dim count As String
Dim strbody As String
Dim Exclude As String
Dim i As Integer
Dim Rec As RecordSet
Dim InputIDs As Variant
Set OracleConnection = New ADODB.Connection
DBConnect = "Provider=msdaora;Data Source=MOSREP;User ID=***;Password=***;"
OracleConnection.Open DBConnect
' Clear Output Sheet Down
Sheets("Output").Select
Range("A2:F10000").Clear
' Set Input Range
Sheets("Input").Columns("A:A").NumberFormat = "0"
InputIDs = Sheets("Input").Range("A2:A10").Value
' SQL Query
SQLQuery = "select DMP.PERSON_ID, DMP.FULL_NAME, DMP.DATE_OF_BIRTH, DMA.ADDRESS, DMA.ADDRESS_TYPE, DMA.IS_DISPLAY_ADDRESS " & _
"from DM_PERSONS DMP " & _
"join DM_ADDRESSES DMA " & _
"on DMA.PERSON_ID=DMP.PERSON_ID " & _
"where DMP.PERSON_ID in (" & InputIDs & ")"
Set MosaicRecordSet = OracleConnection.Execute(SQLQuery)
Sheets("Output").Range("A2").CopyFromRecordset MosaicRecordSet
' Change DOB Format
Sheets("Output").Columns("C:C").NumberFormat = "dd/mm/yyyy"
' Set Left Alignment
Sheets("Output").Columns("A:Z").HorizontalAlignment = xlHAlignLeft
Range("A1").Select
OracleConnection.Close
Set MosaicRecordSet = Nothing
Set OracleConnection = Nothing
ActiveWorkbook.Save
Can anyone shed light on what I am missing? I have attempted to resolve the Type Mismatch issue by setting the 'numberformat' on the column in worksheet "input" to "0" but that didn't help. I also thought that I might have to have a loop to iterate through each record, but I haven't got to that stage yet because of this Type Mismatch thing...
Thank you everyone for your help in advance!
Regards
Matt
The ID's need to be comma delimited
InputIDs = getIDs( Sheets("Input").Range("A2:A10") )
Function getIDs(rng As Range)
Dim c As Range
Dim s As String
For Each c In rng
s = s & c.Value & ","
Next
getIDs = Left(s, Len(s) - 1)
End Function
Related
I'm start to do programming in Access, and I really need help!!
My objective is to create a module that is run in "tbCustoProjeto" table and rewrite the field "Valor HH" values based on Dlookup. I found some solution (by azurous) who I think will solve this, but when I run the code, is returned
"object-required-error".
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
Dim HHTotal As Double
Set HHTotal = DLookup("[CustoTotalNivel]", "tbNivelNome2", "nUsuario='" & tbCustoProjeto!NumUsuario & "'" & "AND Numeric<=" & tbCustoProjeto!DataNumero)
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("tbCustoProjeto", , , adLockBatchOptimistic)
'find the target record
While objRecordset.EOF = False
'If objRecordset.Fields.Item(13).value > 0 Then
objRecordset.Fields.Item(13).value = HHTotal
objRecordset.UpdateBatch
'exit loop
'objRecordset.MoveLast
objRecordset.MoveNext
'End If
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
Print of tbCustoProjeto
Print of tbNivelNome2
Please, someone can tell me where is the error? I don't know what to do.
Cannot reference a table directly like that for dynamic parameter. DLookup should pull dynamic criteria from recordset and within loop. Don't use apostrophe delimiters for number type field parameter.
Remove unnecessary concatenation.
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.Open "tbCustoProjeto", CurrentProject.Connection, , adLockBatchOptimistic
While objRecordset.EOF = False
objRecordset.Fields.Item(13) = DLookup("[CustoTotalNivel]", "tbNivelNome2", _
"nUsuario=" & objRecordset!NumUsuario & " AND Numeric <=" & objRecordset!DataNumero)
objRecordset.UpdateBatch
objRecordset.MoveNext
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
To receive an array with data sorted alphabetically in Excel, I always use something like this:
With ThisWorkbook.Worksheets("data")
LastRow = .Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
.Range("a2:b" & LastRow).Sort key1:=.Range("a1"), order1:=xlAscending
vData = .Range("a2:b" & LastRow)
End With
I can have up to 3 sorting criteria, an infinite number if I run sort multiple times with different sort parameters.
The problem is that it takes time. The worst is when I receive an array as a result of operations within the code and I must first paste the array into worksheet, then sort. With a few hundred thousands of rows, it will take a few seconds.
I used my modifications of QuickSort algorithms to sort numbers, but I imagine that sorting text alphabetically would require 'StrComp', which from my experience is relatively time consuming.
Have you seen or do you think it possible to create a VBA 2 dimensional array alphabetical sorting algorithm (can even be 1 criteria column), which will perform faster than Range.Sort (or pasting huge array + sort)? If yes, how would the strings be compared?
You can try using methods from the ADODB library and simply do a SELECT query on your data where you ORDER BY the text columns in the data which negates the need to write a custom sorting function.
Using this approach will allow you to scale to any number of text columns without worrying how the custom function will deal with multiple columns of text data.
Sample data and output:
Sample code for above - please follow the comments.
Option Explicit
Sub SortDataBy2TextColumnsWithADO()
Dim rngInput As Range
Dim rngOutput As Range
Dim strWbName As String
Dim strConnection As String
Dim objConnection As ADODB.Connection
Dim strRangeReference As String
Dim strSql As String
Dim objRecordSet As ADODB.Recordset
Dim varSortedData As Variant
Dim wsf As WorksheetFunction
' set input range - includes header
Set rngInput = ThisWorkbook.Worksheets("Sheet1").Range("A1:C19")
' set output range - just the first cell
Set rngOutput = ThisWorkbook.Worksheets("Sheet1").Range("E1")
' copy the headers over
rngOutput.Resize(1, 3).Value = rngInput.Rows(1).Value
' connection string for ACE OLEDB provider
strWbName = ThisWorkbook.FullName
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWbName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
' make the connection to current workbook (better saved the workbook first)
Set objConnection = New ADODB.Connection
objConnection.Open strConnection
' get range reference as a string suitable for sql query
strRangeReference = "[" & rngInput.Parent.Name & "$" & rngInput.Address(False, False) & "]"
' get the data ordered by text columns (1 and 2) and values (3)
strSql = "select * from " & strRangeReference & " order by 1, 2, 3"
' populate the recordset
Set objRecordSet = New ADODB.Recordset
objRecordSet.Open strSql, objConnection
' get the sorted data to the variant
varSortedData = objRecordSet.GetRows
' need to transpose the sorted data
varSortedData = WorksheetFunction.Transpose(varSortedData)
' output the transposed sorted data to target range
rngOutput.Offset(1, 0).Resize(UBound(varSortedData, 1), UBound(varSortedData, 2)).Value = varSortedData
' clean up
objRecordSet.Close
Set objRecordSet = Nothing
objConnection.Close
Set objConnection = Nothing
End Sub
Note the following:
I got errors on an unsaved workbook - so probably better than you have saved the workbook at least once
The sorted data needs to be transposed for the output range - see here and here
I have quite a conundrum which I have been trying to troubleshoot. I have a stored procedure in a MySql database, which I call through an Excel VBA application. The VBA application passes the recordset into an Array, and then I use a For Loop to place each of the items in the Array onto a worksheet.
Here's the problem: two of the values in the recordset keep coming back blank in Excel. Oddly, the two are in the middle of the Array, not the beginning or end. However, if I call the stored procedure through another query program such as HeidiSql, I receive ALL values back. I'm at a loss as to why I'm not receiving all of the values through Excel... or why the Array isn't receiving them all, at any rate.
Thanks in advance for your help.
Here is my code:
Sub StartHereFlexFunderCust()
On Error GoTo ErrorHandler
Dim Password As String
Dim SQLStr As String
'OMIT Dim Cn statement. Cn stands for Database Connection
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim custID As String
Dim myArray()
'OMIT Dim rs statement. rs stands for Database Recordset and is the Recordset of what is returned
Set RS = CreateObject("ADODB.Recordset")
Server_Name = Range("O10").Value
Database_Name = Range("O11").Value ' Name of database
'id user or username. We need to write code to insert the current user into this variable (Application.Username) if possible. But they may not be consistent across all machines.
'For example mine is "Ryan Willging" and we would have to shorten it to rwillging but others may be rwillging.
'This is important because if we do not do this all queries will come from the same person and that is not good for debugging.
User_ID = Range("O12").Value
Password = Range("O13").Value
custID = Range("C4").Value 'Deal Number from Start here that we are passing into the stored procedure
'This is the storedprocedure call and it passes in the value of the DealId to the Stored Procedure
SQLStr = "call flexFundByCustomer(" + custID + ")"
Set cn = CreateObject("ADODB.Connection") 'NEW STATEMENT
'This statement takes the variables from the checklist and passes them into a connection string
cn.Open "Driver={MySQL ODBC 5.1 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
'This statement queries the database using the SQL string and the connection string.
'The adOpenStatic variable returns a static copy of a set of records that you can use to find data or generate reports. There are other variables that
'could be used but I think this one will suffice.
RS.Open SQLStr, cn, adOpenForwardOnly
Debug.Print msg 'or MsgBox msg
'Take all of the info from the queries and put them into the spreadsheet
myArray = RS.getrows()
Dim Fld_Name As String
Dim Val_of_Field As String
Dim starthere As Worksheet
Fld_Name = UBound(myArray, 1)
Val_of_Field = UBound(myArray, 2)
Set starthere = ThisWorkbook.Sheets("Start Here")
MsgBox "No error yet defined Start Here!"
'This little loop works well to dump the recordset into excel. We can then map the correct fields 'k inputs the headers and R inputs the rows returned in the Recordset
For K = 0 To Fld_Name ' By using a For loop the data is inputed into excel one row at a time
starthere.Range("U4").Offset(0, K).Value = RS.fields(K).Name
For R = 0 To Val_of_Field
starthere.Range("U4").Offset(R + 1, K).Value = myArray(K, R)
Next
Next
RS.Close
Set RS = Nothing
cn.Close
Set cn = Nothing
ErrorHandler:
MsgBox "There's been an error!"
Exit Sub
End Sub
Consider using Range.CopyFromRecordset method to avoid any use of arrays. Or if memory does not allow, use a Do While Loop across Recordset columns:
' COLUMN HEADERS
For i = 1 To RS.Fields.Count
starthere.("Results").Range("U4").Offset(0, i) = RS.Fields(i - 1).Name
Next i
' DATA ROWS
' COPYFROMRECORDSET APPROACH
starthere.Range("U5").CopyFromRecordset RS
' DO WHILE LOOP APPROACH
starthere.Activate
starthere.Range("U5").Activate
row = 5
Do While Not RS.EOF
For i = 0 To RS.Fields.Count - 1
ActiveCell.Offset(0, i) = RS.Fields(i)
Next i
row = row + 1
ActiveCell.Offset(row, 21)
RS.MoveNext
Loop
As for the values returning empty that may be a MySQL and Excel incompatibility of data types. For instance, you may have a table field set to MySQL's maximum decimal (65, 30) which denotes max digits of 65 and max 30 decimal points which cannot be reflected on a spreadsheet. Current precision limit of a cell value is 15 decimal points.
Alternatively, you may have a VARCHAR(65535) which is the 65,535 byte limit or the open-ended TEXT column of no limit that also cannot be displayed on spreadsheet. Current limit of characters in one cell is 32,767.
Try modifiying column to a smaller type:
ALTER TABLE `tableName` MODIFY COLUMN `largenumberfield` DECIMAL(10,7);
ALTER TABLE `tableName` MODIFY COLUMN `largetextfield` VARCHAR(255);
Why the other programs such as HeidiSQL retrieve values? It might be due to their internal conversion features forcing data values into a specific format (i.e., removing whitespaces, truncating values) which then renders adequately in Excel.
I am trying to run SQL query on sql server (some DWH) and then insert outcome into access table (using VBA).
I did it by using ADODB.Connection, ADODB.Command and ADODB.Recordset. At this point I have my outcome in Recordset and I Wonder how I can insert it into table without looping it.
I tried:
If Not (Rs.EOF And Rs.BOF) Then
Rs.MoveFirst
Do Until Rs.EOF = True
DoCmd.RunSQL ("INSERT INTO Table (F1, F2) VALUES ( " & rs![F1] & ", " & rs[F2] & ")"
Rs.MoveNext
Loop
End If
But Recordset may have over 100k rows. So it would take ages to insert it by using this method.
Another very fast way is to open a new excel workbook paste it into worksheet and then import it. But I would like to avoid it. Is there any other way ?
---------EDITED-----------
Sorry guys. My bad. I was forcing solution with VBA while linkin it was perfect. THANKS !
I was wondering if there is any as fast way which use Access
resources only.
As already mentioned, link the SQL table, then create a simple append query that reads from the linked table and writes to your Access table, and you're done.
I agree with the commenters that you should link if at all possible. But I wanted to see if it could be done. I ended up converting the recordset to a comma delimited file and use TransferText to append it.
Public Sub ImportFromSQLSvr()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sResult As String
Dim sFile As String, lFile As Long
Const sIMPORTFILE As String = "TestImport.txt"
Set cn = New ADODB.Connection
cn.Open msCONN
Set rs = cn.Execute("SELECT SiteID, StoreNumber FROM Site")
'Add a header row, replace tabs with commas
sResult = rs.GetString
sResult = "SiteID, StoreNumber" & vbNewLine & sResult
sResult = Replace(sResult, vbTab, ",")
'Write to a text file
lFile = FreeFile
sFile = Environ("TEMP") & "\" & sIMPORTFILE
Open sFile For Output As lFile
Print #lFile, sResult
Close lFile
'Append to table dbo_Site
DoCmd.TransferText acImportDelim, , "dbo_Site", Environ("TEMP") & "\" & sIMPORTFILE, True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
If you have any commas in your data, you'll need to do some extra work to properly format the csv.
I have some simple code that will load all the data from an excel sheet into an array but I am getting an error 94 inproper use of null due to the fact that my source sheet has some blank columns IE: Q through EA are blank columns but A -P and EB - EF have data. (terrible design for an excel sheet being used as a table I know,.. but I didn't do it)
Seeing as I cant redesign the table.. how can I skip the blanks as to avoid causing errors when loading them into my array?
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
DBPath = "\\MYPATH\MYFILE.xlsm"
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Conn.Open sconnect
sSQLSting = "SELECT * From [log$]"
mrs.Open sSQLSting, Conn
'=>Load the Data into an array
ReturnArray = mrs.GetRows
'Close Recordset
mrs.Close
'Close Connection
Conn.Close
The IsNull() function returns True or False. So include it inside Jet/ACE's conditional logic function IIF()
sSQLString = "SELECT IIF(IsNull(Col1), 0, Col1)," _
& " IIF(IsNull(Col2), 0, Col2)," _
& " IIF(IsNull(Col3), 0, Col3)"
& " From [log$];"
#JohnsonJason Why do you need it in a Array? You could just filter your data with Advanced Filter like here or just drop it and loop to get the columns you need. If you don't know how many columns will be you can create a clone Recordset and get the columns Name and create your Query based on that.
The clone RecordSet is something like this:
'' Declare Variables
Dim oRst As ADODB.Recordset, oRstVal As ADODB.Recordset, oStrm As ADODB.Stream
Dim sHeaders as String
'' Set Variables
Set oRst = New ADODB.Recordset
Set oRstVal = New ADODB.Recordset
Set oStrm = New ADODB.Stream
.... [Something else]
'' Save your current Recordset in the Stream
oRst.Save oStrm
'' Assign your Stream to the new Recordset (oRstVal)
oRstVal.Open oStrm
'' Loop trough your Recorset for Columns Name
'' Use an IF or a Select to filter
For iCol = 0 To oRstVal.Fields.Count - 1
sHeaders = sHeaders + "," + oRstVal.Fields(iCol).Name
Next
And use sHeaders in your Statement in to get the columns you need.
''Instead of Select * From ...
sQuery = "Select " + sHeaders + _
"From ...."