VBA ADODB test is two fields are convertable? - vba

I'm writing a function that copies contents of a recordset(from ADODB library) into another. Specifically copying some contents of Oracle g11(fragment of it) to Access 2007.
Becasue I want to make sure that I write either all contents or none at all- I am checking if the Fields of each recordset are the same(have same Name and Type).
Problem is that very quickly I stumbled upon a case were one recordset has field Type adVarChar and the other has adVarWChar. To be honest I am not sure how are these data types different but as I understand they both represent a variable lenght character field, and correct me if I'm wrong but I should be able to write contents of adVarChar into adVarWChar.
Now I undrstand that there are many more types of strings that ADODB recognizes, and that there many types of integers, doubles, floats .... you get the point.
So my question is how can I detect if you can write/coerce/convert contents of one data type(ADODB's data types) to another?
Is there a susinct and DRY way of doing this?
See my code for reference
Sub AppendRecords(NewRecords As ADODB.Recordset, OriginalRecords As ADODB.Recordset)
Dim AllFieldsMatch As Boolean
Dim Iterator As Integer
Dim ActiveField As Field
Dim FieldCount As Integer
Dim FieldNames() As String
Dim FieldValues() As Variant
FieldCount = NewRecords.Fields.Count
For Iterator = 0 To FieldCount - 1
If NewRecords.Fields(Iterator).Name <> OriginalRecords.Fields(Iterator).Name Then
AllFieldsMatch = False
Err.Raise 10001, "AppendRecords", "Field names are not matching."
End If
Next
For Iterator = 0 To FieldCount
If NewRecords.Fields(Iterator).Type <> OriginalRecords.Fields(Iterator).Type Then
AllFieldsMatch = False
Err.Raise 10002, "AppendRecords", "Field Types are not matching."
End If
Next
If NewRecords.EOF And NewRecords.BOF Then
Err.Raise 10003, "AppendRecords", "There are no records in new Recordset."
End If
Iterator = 0
ReDim FieldNames(Iterator To FieldCount - 1)
ReDim FieldValues(Iterator To FieldCount - 1)
For Each ActiveField In NewRecords.Fields
FieldNames(Iterator) = ActiveField.Name
Next
While Not NewRecords.EOF
For Each ActiveField In NewRecords.Fields
FieldNames(Iterator) = ActiveField.Value
Next
OriginalRecords.AddNew FieldNames, FieldValues
NewRecords.MoveNext
'LogCompletedJob "GetCoverageTable" 'Ignore for now
Wend
End Sub

I've done this before to map ADO field data types with DAO field data types. However I haven't done this with Oracle. This link may help:
https://docs.oracle.com/cd/B19306_01/server.102/b14232/apb.htm
Or this:
https://learn.microsoft.com/en-us/dotnet/framework/data/adonet/oracle-data-type-mappings
You could try and update the field value without checking data types. Add error handling to catch obvious fails and then compare the contents of the two field values to see if the data made it across.
i.e. Remove this:
For Iterator = 0 To FieldCount
If NewRecords.Fields(Iterator).Type <> OriginalRecords.Fields(Iterator).Type Then
AllFieldsMatch = False
Err.Raise 10002, "AppendRecords", "Field Types are not matching."
End If
Next
And add error handling/checks to this part of the code:
For Each ActiveField In NewRecords.Fields
FieldNames(Iterator) = ActiveField.Value
Next

Related

Compare two datatables, if anything is different show MessageBox

I have two datatables, one of them is populated when application starts and the other one is populated on button click. How can i check (fastest way) if anything changed in second datatable?
I have tried this but it does not work:
For Each row1 As DataRow In dtt.Rows
For Each row2 As DataRow In dtt1.Rows
Dim array1 = row1.ItemArray
Dim array2 = row2.ItemArray
If array1.SequenceEqual(array2) Then
Else
End If
Next
Next
The problem is that your loops are nested. This means that the inner For Each loops through each row of dtt1 for each single row of dtt. This is not what you want. You want to loop the two tables in parallel. You can do so by using the enumerators that the For Each statements use internally
Dim tablesAreDifferent As Boolean = False
If dtt.Rows.Count = dtt1.Rows.Count Then
Dim enumerator1 = dtt.Rows.GetEnumerator()
Dim enumerator2 = dtt1.Rows.GetEnumerator()
Do While enumerator1.MoveNext() AndAlso enumerator2.MoveNext()
Dim array1 = enumerator1.Current.ItemArray
Dim array2 = enumerator2.Current.ItemArray
If Not array1.SequenceEqual(array2) Then
tablesAreDifferent = True
Exit Do
End If
Loop
Else
tablesAreDifferent = True
End If
If tablesAreDifferent Then
'Display message
Else
'...
End If
The enumerators work like this: They have an internal cursor that is initially placed before the first row. Before accessing a row through the Current property, you must move to it with the MoveNext function. This function returns the Boolean True if it succeeds, i.e. as long as there are rows available.
Since now we have a single loop statement and advance the cursors of enumerator1 and enumerator2 at each loop, we can compare corresponding rows.
Note that the Rows collection implements IEnumerable and thus the enumerators returned by GetEnumerator are not strongly typed. I.e. Current is typed as Object. If instead you write
Dim enumerator1 = dtt.Rows.Cast(Of DataRow).GetEnumerator()
Dim enumerator2 = dtt1.Rows.Cast(Of DataRow).GetEnumerator()
Then you get enumerators of type IEnumerator(Of DataRow) returning strongly typed DataRows.

Checking if a value is a member of a list

I have to check a piece of user input against a list of items; if the input is in the list of items, then direct the flow one way. If not, direct the flow to another.
This list is NOT visible on the worksheet itself; it has to be obfuscated under code.
I have thought of two strategies to do this:
Declare as an enum and check if input is part of this enum, although I'm not sure on the syntax for this - do I need to initialise the enum every time I want to use it?
Declare as an array and check if input is part of this array.
I was wondering for VBA which is better in terms of efficiency and readability?
You can run a simple array test as below where you add the words to a single list:
Sub Main1()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test("dog") 'True
Debug.Print "horse", Test("horse") 'False
End Sub
Function Test(strIn As String) As Boolean
Test = Not (IsError(Application.Match(strIn, arrList, 0)))
End Function
Or if you wanted to do a more detailed search and return a list of sub-string matches for further work then use Filter. This code would return the following via vFilter if looking up dog
dog, dogfish
In this particular case the code then checks for an exact match for dog.
Sub Main2()
arrList = Array("cat", "dog", "dogfish", "mouse")
Debug.Print "dog", Test1("dog")
Debug.Print "horse", Test1("horse")
End Sub
Function Test1(strIn As String) As Boolean
Dim vFilter
Dim lngCnt As Long
vFilter = Filter(arrList, strIn, True)
For lngCnt = 0 To UBound(vFilter)
If vFilter(lngCnt) = strIn Then
Test1 = True
Exit For
End If
Next
End Function
Unlike in .NET languages VBA does not expose Enum as text. It strictly is a number and there is no .ToString() method that would expose the name of the Enum. It's possible to create your own ToString() method and return a String representation of an enum. It's also possible to enumerate an Enum type. Although all is achievable I wouldn't recommend doing it this way as things are overcomplicated for such a single task.
How about you create a Dictionary collection of the items and simply use Exist method and some sort of error handling (or simple if/else statements) to check whether whatever user inputs in the input box exists in your list.
For instance:
Sub Main()
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
myList.Add "item1", 1
myList.Add "item2", 2
myList.Add "item3", 3
Dim userInput As String
userInput = InputBox("Type something:")
If myList.Exists(userInput) Then
MsgBox userInput & " exists in the list"
Else
MsgBox userInput & " does not exist in the list"
End If
End Sub
Note: If you add references to Microsoft Scripting Runtime library you then will be able to use the intelli-sense with the myList object as it would have been early bound replacing
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")
with
Dim myList as Dictionary
Set myList = new Dictionary
It's up to you which way you want to go about this and what is more convenient. Note that you don't need to add references if you go with the Late Binding while references are required if you want Early Binding with the intelli-sense.
Just for the sake of readers to be able to visualize the version using Enum let me demonstrate how this mechanism could possibly work
Enum EList
item1
item2
item3
[_Min] = item1
[_Max] = item3
End Enum
Function ToString(eItem As EList) As String
Select Case eItem
Case EList.item1
ToString = "item1"
Case EList.item2
ToString = "item2"
Case EList.item3
ToString = "item3"
End Select
End Function
Function Exists(userInput As String) As Boolean
Dim i As EList
For i = EList.[_Min] To EList.[_Max]
If userInput = ToString(i) Then
Exists = True
Exit Function
End If
Next
Exists = False
End Function
Sub Main()
Dim userInput As String
userInput = InputBox("type something:")
MsgBox Exists(userInput)
End Sub
First you declare your List as Enum. I have added only 3 items for the example to be as simple as possible. [_Min] and [_Max] indicate the minimum value and maximum value of enum (it's possible to tweak this but again, let's keep it simple for now). You declare them both to be able to iterate over your EList.
ToString() method returns a String representation of Enum. Any VBA developer realizes at some point that it's too bad VBA is missing this as a built in feature. Anyway, you've got your own implementation now.
Exists takes whatever userInput stores and while iterating over the Enum EList matches against a String representation of your Enum. It's an overkill because you need to call many methods and loop over the enum to be able to achieve what a simple Dictionary's Exists method does in one go. This is mainly why I wouldn't recommend using Enums for your specific problem.
Then in the end you have the Main sub which simply gathers the input from the user and calls the Exists method. It shows a Message Box with either true or false which indicates if the String exists as an Enum type.
Just use the Select Case with a list:
Select Case entry
Case item1,item2, ite3,item4 ' add up to limit for Case, add more Case if limit exceeded
do stuff for being in the list
Case Else
do stuff for not being in list
End Select

DataRow.SetColumnError(Int32, String) ignores Int32 value and always uses zero

Okay, this is doing my head in. I'm calling SetColumnError() on a DataRow object that has 20 columns, but no matter which ColumnIndex I use it sets the error text on column 0. The MSDN documentation makes it plainly clear that the error text is supposed to be set on the column that the ColumnIndex provides.
I'm trying to set error text on columns 1 and 2 (I normally use constants when doing this, I have just used the integers in this example code for simplicity). Why does the error text appear on column 0 and what should I be doing to get the text to show on columns 1 and 2? I'm not receiving IndexOutOfRangeException.
Here is the code I'm having trouble with.
Public Sub ValidateRows()
For Each dgvRow As DataGridViewRow In Me.DataGridView1.Rows
If dgvRow.DataBoundItem IsNot Nothing Then
Dim rowView As DataRowView = dgvRow.DataBoundItem
Dim rowData As MyDataSet.DocumentRow = rowView.Row
rowData.ClearErrors()
If rowData.Revision = rowData.Revision_old Then
rowData.SetColumnError(1, "You must change the revision")
End If
If rowData.InternalRevision = rowData.InternalRevision_old Then
rowData.SetColumnError(2, "You must change the internal revision")
End If
End If
Next
End Sub
I'm not sure, but I think the number of the column must be of the type "DataColumn".

Find specific customer type from listbox

I want to ask about my work.
I have to find specific customer types which are adult, child,concession from listbox customer type.
Here is my code :
Dim iCounter As Integer = 0
Dim sCustType As String = ""
sCustType = "adult" Or "child" Or "concession"
For iCounter = 0 To lstCustType.Items.Count + 1
If lstCustType.Items(iCounter) = sCustType Then
lstQuoteResult.Items.Add(lstQuoteNum.Items(iCounter))
lstCustResult.Items.Add(lstCustType.Items(iCounter))
lstBagResult.Items.Add(lstBaggageWeight.Items(iCounter))
lstBagWeightResult.Items.Add(lstBagWeight.Items(iCounter))
lstDestResult.Items.Add(lstDestinationCost.Items(iCounter))
lstTripResult.Items.Add(lstHighSesason.Items(iCounter))
lstQuiteResult.Items.Add(lstQuiteCarriageCost.Items(iCounter))
lstInsResult.Items.Add(lstInsurance.Items(iCounter))
lstInsCResult.Items.Add(lstInsuraneCost.Items(iCounter))
lstReturnResult.Items.Add(lstReturnTripCost.Items(iCounter))
lstTotalResult.Items.Add(lstTotal.Items(iCounter))
End If
Next
But it does not work. Apparently there is an error said Conversion from string "adult" to type 'Long' is not valid.
Please help me.
Thanks.
Try adding .ToString during your item comparison:
If lstCustType.Items(iCounter).ToString() = sCustType Then
Also, your loop will throw an error as you should be stepping down 1 after the count, not up 1, since the listbox is indexed starting at 0. This would eventually throw an error as the listbox attempts to access an index that doesn't exist. Should read:
For iCounter = 0 To lstCustType.Items.Count - 1
sCustType = "adult" Or "child" Or "concession"
Using the or operator like this, the compiler is expecting to preform a bitwise or on 2 longs. You probably need to make a collection of customer types, then use LINQ to do a specific search of the items collections.

Excel VBA - Initializing Empty User Types and Detecting Nulls

I have created a user defined type to contain some data that I will use to populate my form. I am utilizing an array of that user defined type, and I resize that array as I pull data from an off-site server.
In order to make my program easier to digest, I have started to split it into subroutines. However, when my program is initialized, I cannot tell when a particular array has been initialized, and so I cannot be certain that I can call a size function to see if the array is empty.
Is there a way to initialize an empty user type or detect a null user type? Currently, I am hard-coding it in and I would prefer a more elegant solution.
In addition to isempty(array) solution -
If IsNull(array) then
msgbox "array is empty"
End If
AFAIK, you cannot check whether user-defined type was initialized before it was sent as an argument to a procedure/function.
I am quoting this example from VBA help
Type StateData
CityCode(1 To 100) As Integer ' Declare a static array.
County As String * 30
End Type
The County field is initialized to some value, which you can use a base value.
If the user sets this field explicitly, it means it holds some value & remains uninitialized, otherwise.
for e.g.
Sub main()
Dim example As StateData
MsgBox IsInitialized(example)
Dim example2 As StateData
example2.County = "LA"
MsgBox IsInitialized(example2)
End Sub
Function IsInitialized(arg As StateData) As Boolean
Dim initCounty As String * 30
IsInitialized = (arg.County <> initCounty)
End Function
Try:
dim v
if isempty(v) then
msgbox "is empty"
end if
If myObjectVariable is Nothing
should work to detect if an object has been initialized.
Edit: "is nothing" DOES work, if it is an object variable:
Dim blah As Object
If blah Is Nothing Then
MsgBox "blah is nothing!"
End If
Dim foo as variant
If IsEmpty(foo) Then
MsgBox "foo is empty!"
End If
If you need to check whether the whole dynamic array of custom types was initialized or not (not just particular element) in VBA, then this might not be possible directly (as none of the IsEmpty etc. functions works on custom types). However you might be able to easily restructure your program to return an array of custom types of size 0 to indicate that nothing was read/initialized.
Private Function doStuff() As customType()
Dim result() As customType
' immediately size it to 0 and assing it as result
ReDim result(0)
doStuff = vysledek
' do real stuff, ... premature "Exit Function" will return an array of size 0
' possibly return initialized values
End Function
' then you can all
If (UBound(tabulky) = 0) Then
MsgBox "Nope, it is not initialized."
End If