I have a table with Name as MyTable which has field Names(TEXT) which has values, 'MFG##', 'jkl%980', I have written a function to remove special character like this
Function fn_RemoveSpecialChars(strText As String) As Boolean
Dim db As DAO.Database
Set db = CurrentDb()
Dim output As String
Dim c
Dim i As Integer
For i = 1 To Len(strText)
c = Mid(strText, i, 1)
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c
Else
output = output & ""
End If
Next
fn_RemoveSpecialChars = LTrim(RTrim(output))
End Function`
I am using command click to utilize function to update in MyTable like this
Private Sub Command0_Click()
Dim db As DAO.Database
Set db = CurrentDb()
db.Execute "Update MyTable set Names=fn_RemoveSpecialChars(Names)"
End Sub
If i use the same function as module then it works fine for me, But if i use like a function shown above then it won't work, May be because UPDATE is DML Operation. Because of some user requirement i can't use Modules or procedures, So Is there any alternate way to achieve above ?, Any help would be greatly appreciated.
Input : MFG##$123
Output: MFG123
Your function returns the wrong data type - it must be string, not boolean.
Function fn_RemoveSpecialChars(strText As String) As String
Related
I have a badly designed table containing 4 boolean fields, and only one of these 4 fields needs to be true.
ATM i'm just trying to generate random data for testing, but I'm unable to find a way to randomly set one of the four fields to true for 10000 rows.
Is there any pure SQL way to this or should I use some VBA code to do this?
The database I have to use is Microsoft Access.
Thanks for your help!
EDIT - based on Hmax's answer
Private Sub UpdateRandomColumns_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rdm As Integer
Dim tab(1 To 4) As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Data")
'4 columns that need to randomly be updated per row
tab(1) = "TimeOut"
tab(2) = "Interaction"
tab(3) = "Responses"
tab(4) = "Manual"
rs.MoveFirst
Do Until rs.EOF
rs.Edit
rdm = Int((4 - 1 + 1) * Rnd + 1)
rs(aray(rdm)) = True
rs.Update
rs.MoveNext
Loop
MsgBox("Update successful")
End Sub
You can use in your UPDATE SQL a VBA function like this:
Public Function Random1of4(varID As Variant, intIndex As Integer) As Boolean
Static curID As Variant
Static intVal As Integer
If curID <> varID Then
'new id, generate new random number from 1 to 4
intVal = Int(Rnd * 4 + 1)
curID = varID
End If
Random1of4 = intIndex = intVal
End Function
This function uses static variables, which keep values between function calls. It internally generates new random number from 1 to 4 (intVal) and returns True if intIndex parameter is equal to intVal. New intVal generated if parameter varID changed.
Create this function in standard module, then create and run UPDATE statement with this function - pass to varID any value from table, which is different for every row (normally primary key) and to intIndex a number from 1 to 4 for each of boolean fields:
UPDATE Data
SET TimeOut = Random1of4([ID], 1)
,Interaction = Random1of4([ID], 2)
,Responses = Random1of4([ID], 3)
,Manual = Random1of4([ID], 4);
Ok so i have a complex reason field from one of our logging servers, and i need to break it down to make some sense, problem is the format changes depending on the status.
I managed to find some strings that i can compare the the reason to to get some sense out of it, but I want to distill it down to one reason code.
I scratched my head a bit and got it down to 7 reasons with different criterion, put the criteria in a table and came up with some vb code to do the comparison.
Problem is its dead slow, and half the reporting relies on the Reason code. The basic VBA function is below, This basically loads the criteria into an array and then compares the value against the array to return the ID.
Function Reason_code(LongReason As String) As Integer
Dim NoReason As Integer
Dim I As Integer
Dim J As Integer
Dim x As Boolean
NoReason = recordCount("RejReason") - 1
Dim conExpr() As String
ReDim conExpr(NoReason)
For I = 0 To (NoReason - 1)
conExpr(I) = GetVal("Criterior", "RejReason", "id", CStr(I + 1))
Next I
For J = 0 To (NoReason - 1)
x = LongReason Like conExpr(J)
If x = True Then
GoTo OutOfLoop
End If
Next J
OutOfLoop:
Reason_code = J + 1
End Function
I have used similar in VB before and it tends to be quite fast, so i am reconing that my GetVal function is the problem, but my VBA is rusty and my SQL is pretty non existent, so any help would be appreciated. I tried LSQL and SQL2 as one line but VBA doesnt like it.
Function GetVal(FieldNm As String, TableNm As String, IndexField As String, IndexNo As String) As String
Dim db As Database
Dim Lrs As DAO.Recordset
Dim LSQL As String
Dim LGST As String
Dim SQL2 As String
'Open connection to current Access database
Set db = CurrentDb()
'Create SQL statement to retrieve value from GST table
LSQL = CStr("SELECT " + FieldNm + " FROM " + TableNm)
SQL2 = CStr(LSQL + " WHERE " + IndexField + " = " + IndexNo)
Set Lrs = db.OpenRecordset(SQL2, dbOpenDynaset, dbReadOnly)
'Retrieve value if data is found
If Lrs.EOF = False Then
LGST = Lrs(0)
Else
LGST = "Item Not found"
End If
Lrs.Close
Set Lrs = Nothing
GetVal = LGST
End Function
Thanks in advance,
I Scratched my head for a bit and worked out i could speed it up by doing the read and compare at the same time, its not lightning, but its better
Function ReasonCode(LongReason As String) As String
Dim cdb As Database
Dim rs As DAO.Recordset
Dim RejRea()
Dim NoReason As Integer
Dim result As Boolean
Dim i As Integer
Set cdb = CurrentDb()
Set rs = cdb.OpenRecordset("RejReason", dbOpenDynaset, dbReadOnly)
rs.MoveLast
rs.MoveFirst
NoReason = rs.recordCount - 1
RejRea() = rs.GetRows(rs.recordCount)
For i = 0 To NoReason
result = LongReason Like CStr(RejRea(2, i))
If result = True Then
ReasonCode = CStr(RejRea(1, i))
GoTo outloop
End If
Next i
If ReasonCode = "" Then ReasonCode = "Not Found"
outloop:
Set rs = Nothing
Set cdb = Nothing
End Function
Still not sure its the best way to do it, but in the abscence of any other suggestions it will do for now.
In a query I have an SQL iif statement that incorporates too many iif, therefore I cannot add any more iif, which is a problem.
To solve the problem, I had the idea to code a VBA function, but I am facing difficulties. Here is what I have, with a simple example where we have a Number in a field. In case the number is <0, the function Retrive() should retrieve the value of field TheDate, in case >0 the function should retrieve the value of the field TheOtherDate:
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
End If
r.MoveNext
Next i
End Function
But this does not work because it retrieves the last record for each line, not the right lines.
Your For loop just keeps running until you reach the last record and then exits. You have to jump out of the loop when you reach the correct record (you decide how to determine this).
Option Explicit
Public Function Retrive(NumberToCheck As Integer) As Date
Dim db As Database
Dim r As Recordset
Dim rsCount As Integer
Dim TheDate As Field, TheOtherDate As Field
Dim TheRightDate As Date
Dim i As Integer
Set db = CurrentDb()
Set r = db.OpenRecordset("Table")
Set TheDate = r.Fields("TheDate")
Set TheOtherDate = r.Fields("TheOtherDate")
rsCount = r.RecordCount
r.MoveFirst
TheRightDate = DateValue("1/15/2015")
For i = 1 To rsCount
If NumberToCheck < 0 Then
Retrive = TheDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
If NumberToCheck > 0 Then
Retrive = TheOtherDate.Value
'--- check here to see if you have the correct value
' and if so, the exit the loop
If Retrive = TheRightDate Then
Exit For
End If
End If
r.MoveNext
Next i
End Function
So I have the following code in Access:
Dim db As DAO.Database
Dim qdEPH As DAO.QueryDef
Dim rsEPH As DAO.Recordset
Set qdEPH = DBEngine(0)(0).QueryDefs("MyQuery")
qdEPH.Parameters(0) = Text10.Value
Set db = CurrentDb
Set rsEPH = qdEPH.OpenRecordset
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets("Sheet1")
oSheet.Activate
Dim Count as Long
Count = 1
Do While Not rsEPH.EOF
oSheet.Range("A" & Count).Value = rsEPH("Value1")
Count = Count + 1
rsEPH.MoveNext
Loop
A user puts a value in textbox Text10 on a form and clicks a button to run the code above. It runs the query MyQuery and dumps the results into a recordset named rsEPH. One of the fields, Value1, is stored as a text value in the table being queried. However, it's actually a number. How can I convert rsEPH("Value1") to a number (returning Null or something if it fails) and then divide it by 100?
Use Nz to transform Nulls in the text field before you apply the numeric conversion function. I chose CDbl as the conversion function.
oSheet.Range("A" & Count).Value = CDbl(Nz(rsEPH("Value1"), "0"))
But you mentioned dividing by 100, so maybe you want this ...
oSheet.Range("A" & Count).Value = CDbl(Nz(rsEPH("Value1"), "0")) / 100
Try below code
Do While Not rsEPH.EOF
oSheet.Range("A" & Count).Value = IIf(IsNull(rsEPH("Value1")), 0, CDbl(rsEPH("Value1")))
Count = Count + 1
rsEPH.MoveNext
Loop
I'm assigning an Access 2007 query to a QueryDef in Excel VBA. My query calls a user-defined function, because it performs a calculation on the results of evaluating a field with a regular expression. I'm using a QueryDef because I'm collecting values in a UserForm and want to pass them to the query as parameters.
When I run my VBA code, I get an error: "Run-time error '3085': Undefined function 'regexFunc' in expression."
This question suggests that the problem is that DAO is unable to call Access UDFs from Excel, so I copied my UDF into the Excel VBA module, but I still get the error.
Access query:
select field1 from dataTable where regexFunc(field1)=[regexVal]
Here's the Excel VBA code:
'QueryDef function
Sub makeQueryDef (str As String)
Dim qdf As QueryDef
Dim db As Database
Set db = OpenDatabase(DBpath)
Set qdf = db.QueryDefs("paramQuery")
qdf.Parameters("regexVal") = (str="test")
doSomething qdf
End Sub
'Regex function copied from Access VBA module to Excel VBA module
Function regexFunc(str As String) As Boolean
Dim re As RegExp
Dim matches As MatchCollection
regexFunc = False
Set re = New RegExp
re.Pattern = "\reg[ex](pattern)?"
Set matches = re.Execute(str)
If matches.Count <> 0 Then
regexFunc = True
End If
End Function
This is how I would do it... just tested it and it works fine with my UDF:
One thing - are you required to not use New Access.Application?
Sub GetMyDataWithUDF()
Dim oApp As Access.Application
Dim qd As QueryDef
sFileName = "C:\Users\AUser\Desktop\adatabase.mdb"
Set oApp = New Access.Application
oApp.OpenCurrentDatabase (sFileName)
Set qd = oApp.CurrentDb.QueryDefs("Query1")
If oApp.DCount("*", "MSysObjects", "Name='dataTableResults'") > 0 Then _
oApp.CurrentDb.TableDefs.Delete "dataTableResults"
qd.Parameters("avalue") = "4"
qd.Execute
oApp.Quit
Set oApp = Nothing
Dim oRS As ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFileName & ";User Id=admin;Password=;"
Set oRS = New ADODB.Recordset
oRS.Open "SELECT * FROM dataTableResults", sConn
Sheet1.Cells.Clear
Sheet1.Range("A1").CopyFromRecordset oRS
oRS.Close
Set oRS = Nothing
End Sub
Note that I made my underlying query a SELECT ... INTO query that creates a table called 'dataTableResults'
This is my query (QueryDef) in Access:
SELECT dataTable.Field1, dataTable.Field2 INTO dataTableResults
FROM dataTable
WHERE mysqr(dataTable.Field1)=[avalue];
My MS-Access DB has a function called "mysqr", which gets used in the SQL above.
Function mysqr(Num)
mysqr = Num * Num
End Function
The table "dataTable" I'm querying against is just a list of numbers, so if my parameter "avalue" is "16", then I get the row "4" back. If I enter "4" (as in my code), I get "2" back.
I've solved this. Here's how I did it.
First I change the query into a recordset and pass it to my filtering function:
function filteredQDF(qdf As QueryDef, boolVal As Boolean) As Variant
Dim rs As Recordset
Dim rows_rs As Variant
Dim rs_new As Recordset
Dim filtered As Variant
Set rs = qdf.OpenRecordset
rs.MoveLast
rs.MoveFirst
rows_rs = rs.GetRows(rs.RecordCount)
rows_rs = Application.WorksheetFunction.Transpose(rows_rs)
filtered = filterFunction(rows_rs, boolVal)
filteredQDF = filtered
End Function
And here's the filtering function, which creates a new array, populates it with rows that pass the UDF's boolean check, and returns it:
Function filterFunction(sourceArray As Variant, checkValue As Boolean) As Variant
Dim targetArray As Variant
Dim cols As Long
Dim targetRows As Long
Dim targetCursor As Long
'get # of columns from source array
cols = UBound(sourceArray, 2)
'count total number of target rows because 2D arrays cannot Redim Preserve
'checking sourceArray(r,2) because that's the criterion column
targetRows = 0
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
targetRows = targetRows + 1
End If
Next
'set minimum target rows to 1 so that function will always return an array
If targetRows = 0 Then
targetRows = 1
End If
'redim target array with target row count
ReDim targetArray(targetRows, cols)
'set cursor for assigning values to target array
targetCursor = 0
'iterate through sourceArray, collecting UDF-verified rows and updating target cursor to populate target array
For r = 1 To UBound(sourceArray, 1)
If myUDF(CStr(sourceArray(r, 2))) = checkValue Then
For c = 1 To cols
targetArray(targetCursor, c - 1) = sourceArray(r, c)
Next
targetCursor = targetCursor + 1
End If
Next
'assign return value
filterFunction = targetArray
End Function