I am attempting to create a VBA script for Microsoft Access that pulls titles (such as Mr., Mrs.,Dr.,etc.) from a name field and then return a cleaned specific version of that title. I tried to make a multidimensional array with the title in one column and the cleaned title in another column but when I attempt to compile the script, I get a syntax error. I know the syntax error is because of the multidimensional array as I based this off a previous script that used to just find the old titles and it worked fine. What am I missing that's causing this to be a syntax error? Did I not call the multidimensional array correctly? Admittedly I am new to VBA scripts and rusty in programming in general so forgive me if I'm missing something simple.
Public Function findTitles(inName) As String
' Returns cleaned up titles
Dim strName As String
Dim strTitle As String
Dim Titles As Variant
Titles = Array(Array("Ms", "Ms."), Array("Miss ", "Miss"), Array("Mrs", "Mrs."), Array("Mr", "Mr."), Array("Master", "Master"), Array("Rev", "Rev."), Array("Reverend", "Reverend"), Array("Fr", "Fr."),Array("Father", "Father"), Array("Dr", "Dr."), Array("Doctor", "Doctor"), Array("Atty", "Atty."), Array("Attorney", "Attorney"),Array("Prof", "Prof."), Array("Professor", "Professor"), Array("Hon", "Hon."), Array("Honorable", "Honorable"), Array("Pres", "Pres."), Array("President", "President"), Array("Gov", "Gov."), Array("Governor", "Governor"))
Dim I
I = 0
strTitle = ""
'Compare input to list of Titles
Do
If inName Like Titles(I, 0) & " *" Then
strTitle = Titles(I, 1)
Else
I = I + 1
End If
Loop While (strTitle = "" And I < UBound(Titles))
cleanTitles = strTitle
End Function
The problem is that your array is not multi-dimensional, but nested. The error you are likely getting is not a syntax error, but instead a "Subscript out of range." error. You need to change your array statments like so:
Titles(I, 0)
Should be
Titles(I)(0)
Additionally on your last line you have:
cleanTitles = strTitle
I think you meant:
findTitles = strTitle
Related
In MS Access I have a table with a Short Text field named txtPMTaskDesc in which some records contains numbers, and if they do, at different positions in the string. I would like to recover these numbers from the text string if possible for sorting purposes.
There are over 26000 records in the table, so I would rather handle it in a query over using VBA loops etc.
Sample Data
While the end goal is to recover the whole number, I was going to start with just identifying the position of the first numerical value in the string. I have tried a few things to no avail like:
InStr(1,[txtPMTaskDesc],"*[0-9]*")
Once I get that, I was going to use it as a part of a Mid() function to pull out it and the character next to it like below. (its a bit dodgy, but there is never more than a two-digit number in the text string)
IIf(InStr(1,[txtPMTaskDesc],"*[0-9]*")>0,Mid([txtPMTaskDesc],InStr(1,[txtPMTaskDesc],"*[0-9]*"),2)*1,0)
Any assistance appreciated.
If data is truly representative and number always preceded by "- No ", then expression in query can be like:
Val(Mid(txtPMTaskDesc, InStr(txtPMTaskDesc, "- No ") + 5))
If there is no match, a 0 will return, however, if field is null, the expression will error.
If string does not have consistent pattern (numbers always in same position or preceded by some distinct character combination that can be used to locate position), don't think can get what you want without VBA. Either loop through string or explore Regular Expressions aka RegEx. Set reference to Microsoft VBScript Regular Expressions x.x library.
Function GetNum(strS AS String)
Dim re As RegExp, Match As Object
Set re = New RegExp
re.Pattern = "[\d+]+"
Set Match = re.Execute(strS)
GetNum = Null
If Match.Count > 0 Then GetNum = Match(0)
End Function
Input of string "Fuel Injector - No 1 - R&I" returns 1.
Place function in a general module and call it from query.
SELECT table.*, GetNum(Nz(txtPMTaskDesc,"")) AS Num FROM table;
Function returns Null if there is no number match.
Well, does the number you want ALWAYS have a - No xxxx - format?
If yes, then you could have this global function in VBA like this:
Public Function GNUM(v As Variant) As Long
If IsNull(v) Then
GNUM = 0
Exit Function
End If
Dim vBuf As Variant
vBuf = Split(v, " - No ")
Dim strRes As String
If UBound(vBuf) > 0 Then
strRes = Split(vBuf(1), "-")(0)
GNUM = Trim(strRes)
Else
GNUM = 0
End If
End Function
Then your sql will be like this:
SELECT BLA, BLA, txtPMTaskDesc, GNUM([txtPMTaskDesc] AS TaskNum
FROM myTable
So you can create/have a public VBA function, and it can be used in the sql query.
It just a question if " - No -" is ALWAYS that format, then THEN the number follows this
So we have "space" "-" "space" "No" "space" "-" -- then the number and the " -"
How well this will work depends on how consistent this text is.
I am trying to get three values from a large html file. I thought I could use the substring method, but was informed that the position of the data may change. Basically, in the following code I need to pick out "Total number of records: 106", "Number of records imported:106", and "Number of records rejected: 0"
<B>Total number of records : </B>106</Font><br><Font face="arial" size="2"><B>Number of records imported : </B>106</Font><br><Font face="arial" size="2"><B>Number of records rejected : </B>0</Font>
I hope this is clear enough. Thanks in advance!
Simple string operations like IndexOf() and Substring() should be plenty to do the job. Regular Expressions would be another approach that'd take less code (and may allow more flexibility if the HTML tags can vary), but as Mark Twain would say, I didn't have time for a short solution, so I wrote a long one instead.
In general you'll get better results around here by showing you've at least made a reasonable attempt first and showing where you got stuck. But for this time...here you go. :-)
Private Shared Function GetMatchingCount(allInputText As String, textBefore As String, textAfter As String) As Integer?
'Find the first occurrence of the text before the desired number
Dim startPosition As Integer = allInputText.IndexOf(textBefore)
'If text before was not found, return Nothing
If startPosition < 0 Then Return Nothing
'Move the start position to the end of the text before, rather than the beginning.
startPosition += textBefore.Length
'Find the first occurrence of text after the desired number
Dim endPosition As Integer = allInputText.IndexOf(textAfter, startPosition)
'If text after was not found, return Nothing
If endPosition < 0 Then Return Nothing
'Get the string found at the start and end positions
Dim textFound As String = allInputText.Substring(startPosition, endPosition - startPosition)
'Try converting the string found to an integer
Try
Return CInt(textFound)
Catch ex As Exception
Return Nothing
End Try
End Function
Of course, it'll only work if the text before and after is always the same. If you use that with a driver console app like this (but without the Shared, since it'd be in a Module then)...
Sub Main()
Dim allText As String = "<B>Total number of records : </B>106</Font><br><Font face=""arial"" size=""2""><B>Number of records imported : </B>106</Font><br><Font face=""arial"" size=""2""><B>Number of records rejected : </B>0</Font>"""""
Dim totalRecords As Integer? = GetMatchingCount(allText, "<B>Total number of records : </B>", "<")
Dim recordsImported As Integer? = GetMatchingCount(allText, "<B>Number of records imported : </B>", "<")
Dim recordsRejected As Integer? = GetMatchingCount(allText, "<B>Number of records rejected : </B>", "<")
Console.WriteLine("Total: {0}", totalRecords)
Console.WriteLine("Imported: {0}", recordsImported)
Console.WriteLine("Rejected: {0}", recordsRejected)
Console.ReadKey()
End Sub
...you'll get output like so:
Total: 106
Imported: 106
Rejected: 0
After applying the unpivot procedure, I have an Amount column that has blanks and other characters ( like "-"). I would like to convert those non-numberic values to zero. I use replace procedure but it only converts one at the time.
Also, I tried to use the following script
/**
Public Overrides Sub Input()_ProcessInputRows(ByVal Row As Input()Buffer)
If Row.ColumnName_IsNull = False Or Row.ColumnName = "" Then
Dim pattern As String = String.Empty
Dim r As Regex = Nothing
pattern = "[^0-9]"
r = New Regex(pattern, RegexOptions.Compiled)
Row.ColumnName = Regex.Replace(Row.ColumnName, pattern, "")
End If
End Sub
**/
but i'm getting error.I don't much about script so maybe I placed in the wrong place. The bottom line is that I need to convert those non-numberic values.
Thank you in advance for your help.
I generally look at regular expressions as a great way to introduce another problem into an existing one.
What I did to simulate your problem was to write a select statement that added 5 rows. 2 with valid numbers, the rest were an empty string, string with spaces and one with a hyphen.
I then wired it up to a Script Component and set the column as read/write
The script I used is as follows. I verified there was a value there and if so, I attempted to convert the value to an integer. If that failed, then I assigned it zero. VB is not my strong suit so if this could have been done more elegantly, please edit my script.
Public Overrides Sub Input0_ProcessInputRow(ByVal Row As Input0Buffer)
' Ensure we have data to work with
If Not Row.ColumnName_IsNull Then
' Test whether it's a number or not
' TryCast doesn't work with value types so I'm going the lazy route
Try
' Cast to an integer and then back to string because
' my vb is weak
Row.ColumnName = CStr(CType(Row.ColumnName, Integer))
Catch ex As Exception
Row.ColumnName = 0
End Try
End If
End Sub
I need to pass 8 database column dates to my CalculateMostRecentDate function since vb6 doesnt have a max function. Am i simply able to pass the database values like this? or how would I do it?
Public Function CalculateMostRecentDate(ParamArray dates() As Variant) As Variant
Dim i As Integer
Dim MostRecentDate As Variant
MostRecentDate = dates(LBound(dates))
For i = LBound(dates) + 1 To UBound(dates)
If MostRecentDate < dates(i) Then MostRecentDate = dates(i)
Next i
CalculateMostRecentDate = MostRecentDate
End Function
Call function within another function:
RECENT_APPRV_DT = CalculateMostRecentDate(EMPLOYER.UW_APPRV_DT, EMPLOYER.BE_APPRV_DT, . . .)
Looks about right.
Google turned up this which looks quite polished, also this from the old VB6 newsgroup.
The function looks OK but you cannot call it the way you have indicated. You will need to load the dates into an array and then pass the array in.
I need to remove hyphens from a string in a large number of access fields. What's the best way to go about doing this?
Currently, the entries are follow this general format:
2010-54-1
2010-56-1
etc.
I'm trying to run append queries off of this field, but I'm always getting validation errors causing the query to fail. I think the cause of this failure is the hypens in the entries, which is why I need to remove them.
I've googled, and I see that there are a number of formatting guides using vbscript, but I'm not sure how I can integrate vb into Access. It's new to me :)
Thanks in advance,
Jacques
EDIT:
So, Ive run a test case with some values that are simply text. They don't work either, the issue isn't the hyphens.
I'm not sure that the hyphens are actually the problem without seeing sample data / query but if all you need to do is get rid of them, the Replace function should be sufficient (you can use this in the query)
example: http://www.techonthenet.com/access/functions/string/replace.php
If you need to do some more advanced string manipulation than this (or multiple calls to replace) you might want to create a VBA function you can call from your query, like this:
http://www.pcreview.co.uk/forums/thread-2596934.php
To do this you'd just need to add a module to your access project, and add the function there to be able to use it in your query.
I have a function I use when removing everything except Alphanumeric characters. Simply create a query and use the function in the query on whatever field you are trying to modify. Runs much faster than find and replace.
Public Function AlphaNumeric(inputStr As String)
Dim ascVal As Integer, originalStr As String, newStr As String, counter As Integer, trimStr As String
On Error GoTo Err_Stuff
' send to error message handler
If inputStr = "" Then Exit Function
' if nothing there quit
trimStr = Trim(inputStr)
' trim out spaces
newStr = ""
' initiate string to return
For counter = 1 To Len(trimStr)
' iterate over length of string
ascVal = Asc(Mid$(trimStr, counter, 1))
' find ascii vale of string
Select Case ascVal
Case 48 To 57, 65 To 90, 97 To 122
' if value in case then acceptable to keep
newStr = newStr & Chr(ascVal)
' add new value to existing new string
End Select
Next counter
' move to next character
AlphaNumeric = newStr
' return new completed string
Exit Function
Err_Stuff:
' handler for errors
MsgBox Err.Number & " " & Err.Description
End Function
Just noticed the link to the code, looks similar to mine. Guess this is just another option.