DataReader with Multiple Row - mysql

I'm trying to use the DataReader to grab data from a MS ACCESS Database and then using the items in the datareader to do some calculations. This is what I'm doing with one row.
Dim dataRead As OleDb.OleDbDataReader = dataCom1.ExecuteReader
If (dataRead.Read() = True) Then
x = dataReader.Item("x")
y = dataReader.Item("y")
z = dataReader.Item("z")
End If
I'm trying to do the same with multiple rows that are retrieved at random. At the moment I have this:
Dim dataRead2 As OleDb.OleDbDataReader = dataCom2.ExecuteReader
For i As Integer = 0 To 4
If (dataRead2.Read() = True) Then
a(i) = dataRead2.Item("z")
b(i) = dataRead2.Item("y")
c(i) = dataRead2.Item("x")
i = i + 1
End If
Next
Whenever I run it I get an error.
I get the error "Object reference not set to an instance of an object." on the line a(i)"

It appears your array is declared, but not with any specific dimensions. You should declare it as:
Dim Descarray(4) As String
Which will hold 5 strings (0...4)
You can also use:
ReDim Descarray(5)
After the array has already been declared.

Related

Access For Loop Hide Objects

I'm trying to hide/unhide around 30 objects on my form when the user selects certain values from a dropdown menu. I tried the loop below, however I receive the following error: 'Object doesn't support this property or method.' I have this code running on the 'AfterUpdate' of the dropdown menu object.
Dim VisibleVisitFields() As String
Dim VisibleVisitFieldlist As String
Dim varVisibleVisit As Variant
VisibleVisitFieldlist = "VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event"
VisibleVisitFields = Split(VisibleVisitFieldlist, ",")
If (EventType = 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = True
Exit For
Next
Else
If (EventType <> 3) Then
For Each varVisibleVisit In VisibleVisitFields
[Forms]![subFRM_TBL_Event-All in One].Controls(varVisibleVisit).visible = False
Exit For
Next
End If
End If
Which line triggers the error? Suspect it is reference to the subform that is flawed. Never seen code like that to loop through an array. Suggest naming subform container different from the object it holds, such as ctrEvent. What is EventType - a textbox/field on the form? Consider code:
Dim aryFields As Variant
Dim x As Integer
aryFields = Split("VisitDate_Event,VisitTime_Event,VisitSite_Event,VisitStaff_Event,VisitMeet_Event", ",")
For x = 0 To UBound(aryFields)
Me.ctrEvent.Form.Controls(aryFields(x)).Visible = Me.EventType = 3
Next
Alternative methods not using array:
Set control Tag property then code loops through all controls on form and sets visibility for those that have particular value in Tag.
Dim ctrl As Control
For Each ctrl in Me.ctrEvent.Form.Controls
If ctrl.Tag = "something" Then ctrl.Visibility = Me.EventType = 3
Next
Another is to give controls similar names, like: Visit1, Visit2, etc. Then code:
Dim x As Integer
For x = 1 to 30
Me.ctrEvent.Form.Controls("Visit" & x).Visible = Me.EventType = 3
Next
Advise no spaces or punctuation/special characters (underscore only exception) in naming convention.
You are trying to iterate over an array of strings.
Dim VisibleVisitFields() As String
You need to declare the array to contain variants (which can still contain strings)
Dim VisibleVisitFields() As Variant

Extracting Tables From Email, innerHTML err 91

have been googling around for a code to extract tables from emails and am trying to adapt the codes by changing early binding to late binding.
However, the code seems to bug out at the objHTML.body.innerHTML = objMailItem.HTMLBody line.
Code seems to run alright when used in Excel but bugs out when I run on outlook vba.
any help to point me in the right direction would be appreciated!
Public Function ExtractOutlookTables(objMailItem As Object) As Object
Dim vTable As Variant
Dim objHTML As Object: Set objHTML = CreateObject("htmlFile")
Dim objEleCol As Object
objHTML.Body.innerHTML = objMailItem.HTMLBody ' <<error line>>
With objHTML
objHTML.Body.innerHTML = objMailItem.HTMLBody
Set objEleCol = .getElementsByTagName("table")
End With
'import in Excel
Dim x As Long, y As Long
For x = 0 To objEleCol(0).Rows.Length - 1
For y = 0 To objEleCol(0).Rows(x).Cells.Length - 1
vTable(x, y) = objEleCol(0).Rows(x).Cells(y).innerText
Next y
Next x
ErrorHandler:
Set objHTML = Nothing: Set objEleCol = Nothing
End Function
''
' Function that returns a dictionary of arrays of strings, each representing a table in the email; key = 0 represents the most recent table
' #param objMailItem object representing an Outlook Mail Item object
' #return Dictionary of arrays of strings where each key represents the index of the table (0 being the most recent table)
' #remarks Please note that index 0 = table in the most recent email conversation
' #see none
Public Function fnc_ExtractTablesFromMailItem(objMailItem As Object) As Object
Dim objHTMLDoc As Object: Set objHTMLDoc = CreateObject("HTMLFile")
Dim dicTables As Object: Set dicTables = CreateObject("scripting.Dictionary")
Dim arrTable() As String
Dim objTable As Object
Dim lngRow As Long
Dim lngCol As Long
Dim intCounter As Integer: intCounter = 0
objHTMLDoc.body.innerHTML = objMailItem.htmlbody
' Loop through each table in email
For Each objTable In objHTMLDoc.getElementsByTagName("table")
ReDim arrTable(objTable.Rows.Length - 1, objTable.Rows(1).Cells.Length - 1)
For lngRow = 0 To objTable.Rows.Length - 1
Set rw = objTable.Rows(lngRow)
For lngCol = 0 To rw.Cells.Length - 1
' Ignore any problems with merged cells etc
On Error Resume Next
arrTable(lngRow, lngCol) = rw.Cells(lngCol).innerText ' Store each table in 1 array
On Error GoTo 0
Next lngCol
Next lngRow
dicTables(intCounter) = arrTable ' Store each array as a dictionary item
intCounter = intCounter + 1
Next objTable
Set fnc_ExtractTablesFromMailItem = dicTables
' Garbage collection
Set dicTables = Nothing: Set objTable = Nothing: Set objHTMLDoc = Nothing
End Function
The problem seems to be in the code that is calling the function. You should post that code.
If the only thing that you actual want from objMailItem is it's HTMLBody then objMailItem As Object should be removed from function signature should and replaced with HTMLBody as String.
You must be missing a couple of lines of code; because vTablewas never allocated and will throw a type mismatch error the way the function is written.
You should also wrap your test whether objEleCol is Nothing before you try and use it.
Here I pass the MailItem to fnc_ExtractTablesFromMailItem from Application_ItemSend to in Outlook. There are no errors.
The Application_NewMail and Application_NewMailEx events do not recieve MailItems as parameters. How are you retrieving the MailItem that you are passing into your function?

Multiselect rows in listbox based on string

I have a multiselect listbox that has around 60 values, the user can go through and select anything they want I can successfully read everything selected and output it as one line like this "1,2,3,4,5" and store that value. The problem I currently have is when the user needs to edit what was selected. How can I reselect the listbox items based on the string "1,2,3,4,5" that was stored earlier?
I figured it out after a lot of searching, here is the code
Dim strValue As String
Dim strArray() As String
Dim x As Integer
Dim startRow As Integer
strValue = rsPrints("ctype")'Get string of row values
strArray = Split(strValue, ",", -1, vbTextCompare)'My string required splitting to remove commas and moving to an array
x = 0 'Set array start point to 0
For Q = LBound(strArray) To UBound(strArray) 'Run through array
startRow = strArray(x)
Me.formctype.Selected(startRow) = True
x = x + 1
Next

MS ACCESS VBA module Auto number format

I have a Repoerteq table with a REQ_NUM as ID and another column named "REQ_department".
REQ_department have defult values such as ""Finance".
I want to make VBA looks at the department and then set a prefix formate for REQ_NUM
example is department is finance then it would make id as "FIN 000"
the following code is what i manage fo far but it still not working
Option Compare Database
Function GetData() As String
Dim db As Database
Dim Rrs As DAO.Recordset
Dim RSQL As String
Dim RepData As String
Dim RepDep As String
'TO open connection to current Access DB
Set db = CurrentDb()
'TO create SQL statement and retrieve value from ReportReq table
RSQL = "select * from ReportReq"
Set Rrs = db.OpenRecordset(RSQL)
'Retrieve value if data is found
If Rrs.EOF = False Then
RepData = Rrs("REQ_NUM")
RepDep = Rrs("Req_department")
Else
RepData = "Not found"
RepDep = "Not found"
End If
Lrs.Close
Set Lrs = Nothing
GetData = RepData
If ReqDep = "finance" Then
Range("REQ_NUM") = Format$("FIN", REQ_NUM)
End If
End Function
You'll have to change your call to the Format() function which tries to format a number or date according to the format string. In addition, you're using an undefined variable REQ_NUM.
If ReqDep = "finance" Then
Range("REQ_NUM") = "FIN " & Format$("000", CLng(RepData))
' ^^^^^^ ^^^^^^^^^^^^^^^^^^^^
End If

extract numbers from string in access

I need help creating a VB code or expression in Access 2010 that will group numbers from a string where each set starts with number 6 and is always 9 characters long.
Example of strings:
Order Confirmation # 638917872-001 Partial Order/$23.74 RECEIVED
Order Confirmation - Multiple Orders - Order Confirmation#639069135-001/$297.45 - Order Confirmation#639069611-001/$32.08.
I'm using a VB code to remove all the alpha characters but that just leaves me with:
6389178720012374 from string 1 and
639069135001297456390696110013208 from string 2.
All I care about is the order number that starts with 6 and is 9 characters long. Any help would be greatly appreciated, I know there's an easier way.
VB.NET Solution:
If you just need the first 9 numbers from your resulting strings you could use String.Substring, ie:
Dim numberString as String = "6389178720012374"
Dim newString As String = numberString.Substring(0, 9)
MessageBox.Show(newString)
shows 638917872
MSDN Link
EDIT:
Maybe you would want to use a RegEx - something like this perhaps can get you started:
Private Sub Input()
Dim numberString As String = "Order Confirmation # 638917872-001 Partial Order/$23.74 RECEIVED"
Dim numberString2 As String = "Order Confirmation - Multiple Orders - Order Confirmation#639069135-001/$297.45 - Order Confirmation#639069611-001/$32.08"
GiveMeTheNumbers(numberString)
GiveMeTheNumbers(numberString2)
End Sub
Function GiveMeTheNumbers(ByVal s As String) As String
Dim m As Match = Regex.Match(s, "6\d{8}") 'get 9 digit #s begin w/6
Do While m.Success
MessageBox.Show(m.Value.ToString)
m = m.NextMatch()
Loop
Return False
End Function
Results -
MessageBox1: 638917872
MessageBox2: 639069135
MessageBox3: 639069611
You can use this function ... tested in VB.NET
Function NumOnly(ByVal s As String) As String
sRes = ""
For x As Integer = 0 To s.Length - 1
If IsNumeric(s.Substring(x, 1)) Then sRes = sRes & s.Substring(x, 1)
Next
return sRes
End Function
Little modif for ms-access
OK, here's a VBA solution. You'll need to add Microsoft VBScript Regular Expressions to your references.
This will match every 9 digit number it finds and return an array of strings with the order #s.
Function GetOrderNum(S As String) As String()
Dim oMatches As Object
Dim aMatches() As String
Dim I As Integer
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
ReDim aMatches(0)
RE.Pattern = "\d{9}"
RE.Global = True
RE.IgnoreCase = True
Set oMatches = RE.Execute(S)
If oMatches.Count <> 0 Then
ReDim aMatches(oMatches.Count)
For I = 0 To oMatches.Count - 1
aMatches(I) = oMatches(I)
Next I
End If
GetOrderNum = aMatches
End Function