I am having some issue with a value that is being determined from some VBA code in my Access tool. I am quite a beginner with VBA and this code was developed alongside a very experienced VBA programmer (who has gone away hence is unable to assist me).
This is the code in question:
Private Sub ValidatePrinting()
Dim rst As DAO.Recordset, PrintMethodVal As Boolean, PracIdVal As Long, datePrintedcol As String, PrintedCount As Integer, ImportedCount As Integer
Dim fromtxt As String, wheretxt As String, conditionalImportedCount As Integer, PrintConditions As Boolean
PrintMethodVal = Me.filter_PrintMethod.Value
PracIdVal = Me.filter_PracticeID.Value
datePrintedcol = Me.filter_LetterRound.Value
datePrintedcol = IIf(datePrintedcol = "1st Round", "datePrinted_1st", IIf(datePrintedcol = "2nd Round", "datePrinted_2nd", ""))
PrintedCount = Me.filter_LetterCount.Value
PrintConditions = Me.filter_PrintConditions.Value
If (datePrintedcol = "") Then
Call DisplayMessage("All letters already sent")
Else
fromtxt = " tbl_main_ListLog as T INNER JOIN tbl_dbextract_GPPractice as GPP ON T.GPPracticeID = GPP.Id"
wheretxt = PrintSQLCriteria(PracIdVal, datePrintedcol)
Set rst = CurrentDb.OpenRecordset(PrintValidationSQL(PrintMethodVal, fromtxt, wheretxt))
ImportedCount = rst.Fields(0).Value
conditionalImportedCount = rst.Fields(1).Value
If ImportedCount = conditionalImportedCount Then
If ImportedCount = PrintedCount Then
If PrintMethodVal = PrintConditions Then
tb_Result = "All OK"
CurrentDb.Execute (" update " & fromtxt & " set " & datePrintedcol & " = date() " & wheretxt)
Else
tb_Result = "Wrong print method selected"
End If
Else
tb_Result = "Counts don't match"
End If
Else
tb_Result = "Mismatched print conditions"
End If
End If
End Sub
So the issue is, when the PrintMethodVal does not equal PrintConditions it outputs "Mismatched Print conditions" as opposed to the "Wrong print method selected" which is what it should. It also outputs "Mismatched Print conditions" when the ImportedCount also does not equal the PrintedCount (as well as the first situation), which is weird as the If should end there and output "Counts don't match".
This code was functioning correctly when originally developed, but I had to include the check for PrintMethodVal = PrintConditions.
What am I missing here?
Related
I'm kinda new to MS Access and I'm sort of learning while coding, so forgive me if my question is a bit weird.
I have created a form based on a table, and in the form I have a text box that the user would type something and it should filter the table and show the results based on what the user typed. There are two forms with pretty much the same code on them (named Rec and Cx). In one of them (Rec) the above description works just fine, but the other (Cx) don't and I get a run-time error 2185. Let me show you some code:
Private Sub strConsRecDesc_KeyUp(KeyCode As Integer, Shift As Integer)
FiltroRec = ""
FilterTextDesc = ""
If Len("" & Me.strConsRecDesc.Text) > 0 Then
intLenDesc = Len(Me.strConsRecDesc.Text)
RequeryForm
strConsRecDesc.SetFocus
Me.FilterOn = True
If intLenDesc > Len(Me.strConsRecDesc.Text) Then
Me.strConsRecDesc = Me.strConsRecDesc & " "
Else
Me.strConsRecDesc = FilterTextDesc
End If
strConsRecDesc.SelStart = intLenDesc
Else
RequeryForm
strConsRecDesc.SetFocus
End If
End Sub
I heard it is good practice to lable variables and fields based on data type, so here int stands for integer, str for strings and Desc refers to the Description field.
Based on what is typed in the field strConsRecDesc I filter the table using the RequeryForm in there, that basically checks all the fields in the form that the user can write into. Let me show you the part for the description field:
strConsRecDesc.SetFocus
If Len(strConsRecDesc.Value) > 0 Then
FilterTextDesc = Me!strConsRecDesc.Value
If Len(FiltroRec) > 0 Then
FiltroRec = FiltroRec & " And "
End If
FiltroRec = FiltroRec & "[recDescricao] LIKE '*" & FilterTextDesc & "*'"
End If
In this form (Rec), I can write, i.e. this is a test and no record is shown, because there is no record with this is a test written in it, and that is correct. If I type something that matches the criteria it works just fine.
However, in the other form (the Cx one), I have the following code for KeyUp:
Private Sub strConsCxDesc_KeyUp(KeyCode As Integer, Shift As Integer)
FiltroCx = ""
FilterTextDesc = ""
If Len("" & Me.strConsCxDesc.Text) > 0 Then
intLenDesc = Len(Me.strConsCxDesc.Text)
RequeryForm
strConsCxDesc.SetFocus
Me.FilterOn = True
If intLenDesc > Len(Me.strConsCxDesc.Text) Then
Me.strConsCxDesc = Me.strConsCxDesc & " "
Else
Me.strConsCxDesc = FilterTextDesc
End If
strConsCxDesc.SelStart = intLenDesc
Else
RequeryForm
strConsCxDesc.SetFocus
End If
End Sub
And the equivalent RequeryForm for the Cx is:
strConsCxDesc.SetFocus
If Len(strConsCxDesc.Value) > 0 Then
FilterTextDesc = Me!strConsCxDesc.Value
If Len(FiltroCx) > 0 Then
FiltroCx = FiltroCx & " And "
End If
FiltroCx = FiltroCx & "[cxDescricao] LIKE '*" & FilterTextDesc & "*'"
End If
But in the Cx one if I type this is a test in the strConsCxDesc textbox I get a run-time error 2185.
I understand that with just this bit of code it is kinda hard to grasp what I'm trying to do, but I really don't know why I'm getting this error if the code is the same.
I appreciate any help, and I'm sorry for my bad english, it's not my mother language.
Thanks in advance.
I have an access database, in many of the tables is a field called "Notes".
This field is used by techs to, well, make notes on the equipment.
But these notes need to be broken up into useful groups, as such we've chosen to use "|" as the delimiter. ( . , ; : - _ / \ all have valid notes uses and can not be assigned to this role)
I've tried :
If Split(rst!Notes, "|")(1).Property = "" Then
aNotesOver = ""
Else
aNotesOver = Split(rst!Notes, "|")(1)
End If
'AND:
If Split(rst!Notes, "|")(1) <> "" Then
aNotesOver = Split(rst!Notes, "|")(1)
Else
aNotesOver = Nz(Split(rst!Notes, "|"), "")
End If
'AND:
If Nz(Split(rst!Notes, "|")(1)) = "" Then
aNotesOver = ""
Else
aNotesOver = Split(rst!Notes, "|")(1)
End If
'AND I tried:
If Not IsNull(Split(rst!Notes, "|")(1)) Then
aNotesOver = Split(rst!Notes, "|")(1)
Else
aNotesOver = ""
End If
None of them work, and I keep getting the "Invalid use of Null " Error.
Anyone have any suggestions?
This is one of those unfortunate quirks of VBA. if the passed value is null, then the split function fails.
and if you pass a empty string, then the ubound() value of the array is -1!!!!
So, this is messy.
I would suggest that you build your own custom function:
Public Function MySplit(v As Variant, ix As Integer) As String
MySplit = ""
If IsNull(v) Then Exit Function
If v = "" Then Exit Function
Dim vBuf As Variant
vBuf = Split(v, "|")
If ix > UBound(vBuf) Then Exit Function
MySplit = vBuf(ix)
End Function
So you could add a delimter to this function.
But, now your code is:
aNotesOver = MySplit(rst!Notes, 1)
And if the 1 is larger then the number of values, it will still return ""
I have a TextBox and it contains this text "File Was Created"
I would like to place the cursor one space over from the end of this text in the TextBox
I am trying to NOT say Simple Enough Task BUT I have wasted 2 hours with no solution
YES I know if I change the text to this "File Was Created " it will work NOT a solution
Here is the code mess I have tried
Dim L As Integer
L = tbMessage.Text.Length
L += 1
'tbMessage.Text = CStr(L)
'tbHaveTwo.Text = frmOne.vR
'Me.ActiveControl = tbMessage
'tbMessage.SelectionStart = tbMessage.Text.Length
tbMessage.SelectionStart = L
tbMessage.Select()<br/>
Here is Two updated ways to solve this issue Jimi way less code
tbMessage.Text = "File Was Created"
'This Code involves more code
'Dim str As String
'str = Mid(tbMessage.Text, tbMessage.Text.Length)
'If str <> " " Then
' tbMessage.Text = tbMessage.Text & " "
'End If
'Answer from Jimi Works Great
tbMessage.AppendText(ChrW(32))
tbMessage.SelectionStart = tbMessage.Text.Length
tbMessage.Select()
So you don't end up with a ton of spaces on the end of your message?
tbMessage.AppendText(If(tbMessage.Text.EndsWith(" "), "", " "))
tbMessage.SelectionStart = tbMessage.TextLength
tbMessage.Focus()
I have done some research and haven't found any similar question.
I have a VBA macro that imports a .CSV file containing telegrams sent by a device.
In the end of this macro, I want to create a graph with the time elapsed on the x-axis and the value corresponding to the telegram.
The issue is that this value can be of different types: hexadecimal, boolean, integer... And that they don't respect the standard Excel number format, which means that they can't be used to create a graph.
Here are some examples (with " around the value to show its start and end) :
hexadecimal : "A7 C8"
Boolean : "$00" or ""$01"
Percentage : "$30"
And here is an example of data, with custom time format and boolean value
Here is my related code so far, where I try to convert into a custom type then convert back to numeric to get a common number datatype :
If wsRes.Range("R1").Value Like "$##" Then
wsRes.Range("R1:R" & plotLine).NumberFormat = "$##"
wsRes.Range("R1:R" & plotLine).NumberFormat = General
End If
If wsRes.Range("R1").Value Like "??[ ]??" Then
Dim valArray(1) As String
For i = 1 To plotLine Step 1
valArray = Split(wsRes.Range("R" & i), " ")
wsRes.Range("R" & i).Value = ToInt32(valArray(0) + valArray(1), 16)
wsRes.Range("" & i).NumberFormat = General
Next i
End If
I haven't been able to test it with hexa yet, but the conversion trick doesn't work with percentage/boolean
EDIT :
First, thank you for your answers.
Here is my final code for anyone's interested, adapted from Vityata's.
This method will allow to easily add other datatypes if needed.
Sub TestMe()
Dim RangeData as String
Set wsRes = ActiveWorkbook.Sheets("Results")
For i = 1 To plotLine Step 1 'plotLine is the last line on which I have data
DetectType wsRes.Range("R" & i).Value, i
Next i
RangeData = "Q1:R" & plotLine
CreateGraph RangeData 'Call My sub creating the graph
End Sub
Public Sub DetectType(str As String, i As Integer)
Select Case True
Case wsRes.Range("R" & i).Value Like "??[ ]??"
wsRes.Range("R" & i).Value = HexValue(str)
Case wsRes.Range("R" & i).Value Like "?##"
wsRes.Range("R" & i).Value = DecValue(str)
Case Else
MsgBox "Unsupported datatype detected : " & str
End
End Select
End Sub
Public Function HexValue(str As String) As Long
Dim valArray(1) As String 'Needed as I have a space in the middle that prevents direct conversion
valArray(0) = Split(str, " ")(0)
valArray(1) = Split(str, " ")(1)
HexValue = CLng("&H" & valArray(0) + valArray(1))
End Function
Public Function DecValue(str As String) As Long
DecValue = Right(str, 2)
End Function
You need three boolean functions, following your business logic and some of the Clean Code principles (although the author of the book does not recognize VBA people as programmers):
IsHex()
IsBoolean()
IsPercentage()
Public Sub TestMe()
Dim myInput As Variant
myInput = Array("A7C8", "$01", "$30")
Dim i As Long
For i = LBound(myInput) To UBound(myInput)
Debug.Print IsHex(myInput(i))
Debug.Print IsBoolean(myInput(i))
Debug.Print IsPercentage(myInput(i))
Debug.Print "-------------"
Next i
'or use this with the DetectType() function below:
'For i = LBound(myInput) To UBound(myInput)
' Debug.Print DetectType(myInput(i))
'Next i
End Sub
Public Function IsHex(ByVal str As String) As Boolean
On Error GoTo IsHex_Error
IsHex = (WorksheetFunction.Hex2Dec(str) <> vbNullString)
On Error GoTo 0
Exit Function
IsHex_Error:
End Function
Public Function IsBoolean(ByVal str As String) As Boolean
IsBoolean = CBool((str = "$00") Or (str = "$01"))
End Function
Public Function IsPercentage(ByVal str As String) As Boolean
IsPercentage = (Len(str) = 3 And Left(str, 1) = "$" And IsNumeric(Right(str, 2)))
End Function
Then some additional logic is needed, because $01 is both Boolean and Percentage. In this case, you can consider it Percentage. This is some kind of a mapper, following this business logic:
Public Function DetectType(str) As String
Select Case True
Case IsHex(str)
DetectType = "HEX!"
Case IsPercentage(str) And IsBoolean(str)
DetectType = "Boolean!"
Case IsPercentage(str)
DetectType = "Percentage!"
Case Else
DetectType = "ELSE!"
End Select
End Function
I am writing an automation script as I have a need to run a report on 16 separate split skills each day for a period of 6 months. The script works, with one problem. It will run 63 iterations (i.e. 3 days at 16 = 48 + 15 = 63). After the 15th loop (63rd overall iteration) it will give an error: "microsoft excel is waiting for another application to complete an OLE action" It would appear to me, though I could very easily be wrong, that either I am overloading a variable or possibly not fully closing something on the CMS side. The fact that it is the 63rd iteration (64-1) seems awfully suspicious, but I am not sure what I could be overloading as far as variables going. I don't have any 8-bit variables (unless I am missing something). Also, I should point out that after running the macro, I am uanble to log back into the CMS app manually without restarting, so my hunch is that I am not fully closing something and that maybe there is a limit on the number of instances allowed in CMS. I included the script below, except that the names of the skills, server address, username and password have been removed for security reasons. Any help would be greatly appreciated.
Public Sub Single_CMS_Report_Extract()
On Error Resume Next
' Add the files specified below to the References section:
' Tools -> References -> Browse to the CMS directory,
' e.g.: "C:\Program Files\Avaya\CMS Supervisor R14"
Dim cmsApplication As ACSUP.cvsApplication 'acsApp.exe
Dim cmsServer As ACSUPSRV.cvsServer 'acsSRV.exe
Dim cmsConnection As ACSCN.cvsConnection 'cvsconn.dll
Dim cmsCatalog As ACSCTLG.cvsCatalog 'cvsctlg.dll
Dim cmsReport As Object 'ACSREP.cvsReport 'acsRep.exe
Dim myLog As String, myPass As String, myServer As String
Dim reportPath As String, reportName As String, reportPrompt(1 To 2, 1 To 3) As String
Dim exportPath As String, exportName As String
Dim StartRunTime, EndRunTime As Date
Dim DayToRun, EndDate As Date
Dim Skill(1 To 16) As String
MsgBox ("Please ensure CMS open and logged in prior to continuing")
StartRunTime = Now
'Start Date
DayToRun = "12/16/2015"
'End Date
EndDate = "12/21/2015"
Skill(1) = "XXXXXXXX"
Skill(2) = "XXXXXXXX"
Skill(3) = "XXXXXXXX"
Skill(4) = "XXXXXXXX"
Skill(5) = "XXXXXXXX"
Skill(6) = "XXXXXXXX"
Skill(7) = "XXXXXXXX"
Skill(8) = "XXXXXXXX"
Skill(9) = "XXXXXXXX"
Skill(10) = "XXXXXXXX"
Skill(11) = "XXXXXXXX"
Skill(12) = "XXXXXXXX"
Skill(13) = "XXXXXXXX"
Skill(14) = "XXXXXXXX"
Skill(15) = "XXXXXXXX"
Skill(16) = "XXXXXXXX"
While DayToRun < (EndDate + 1)
For i = 1 To 16
' Assigns Variables
myLog = "myuser"
myPass = "mypass"
myServer = "xx.xx.xx.xx"
'reportPath is the tab and "Category" that the report is found in Avaya
reportPath = "Historical\Split/Skill\"
reportName = "Summary Interval"
'list of input names requested.....
reportPrompt(1, 1) = "Split/Skill"
reportPrompt(1, 2) = "Date"
reportPrompt(1, 3) = "Times"
'list of responses being used for input
reportPrompt(2, 1) = Skill(i)
reportPrompt(2, 2) = DayToRun
reportPrompt(2, 3) = "00:00-23:30"
'path and name of exported report file
exportPath = "H:\Avaya data\"
If i <> 5 Then
exportName = Month(DayToRun) & "-" & Day(DayToRun) & "-" & Skill(i) & ".csv"
Else
exportName = Month(DayToRun) & "-" & Day(DayToRun) & "- DL-Toll Free" & ".csv"
End If
' Open the CMS Application, launches acsApp.exe
' If a CMS Supervisor console is already open,
' the existing acsApp.exe is used.
Set cmsApplication = CreateObject("ACSUP.cvsApplication")
Set cmsServer = CreateObject("ACSUPSRV.cvsServer")
Set cmsConnection = CreateObject("ACSCN.cvsConnection")
cmsConnection.bAutoRetry = True
' Connetsc to the server, launches acsSRV.exe & ACSTrans.exe (2x)
If cmsApplication.CreateServer(myLog, myPass, "", myServer, False, "ENU", cmsServer, cmsConnection) Then
If cmsConnection.login(myLog, myPass, myServer, "ENU", "", False) Then
End If
End If
' Gets collection of Reports available on cmsServer
Set cmsCatalog = cmsServer.Reports
If cmsServer.Connected = False Then cmsServer.Reports.ACD = 1
' Sets parameters for report, launches ACSRep.exe (2x)
cmsCatalog.CreateReport cmsCatalog.Reports.Item(reportPath & reportName), cmsReport
If cmsReport.SetProperty(reportPrompt(1, 1), reportPrompt(2, 1)) And cmsReport.SetProperty(reportPrompt(1, 2), reportPrompt(2, 2)) And cmsReport.SetProperty(reportPrompt(1, 3), reportPrompt(2, 3)) Then
End If
' Runs report and extracts results --- the 44 is the field delimiter
cmsReport.ExportData exportPath & exportName, 44, 0, False, False, True
' Kills active report & server
If Not cmsServer.Interactive Then
cmsServer.ActiveTasks.Remove cmsReport.TaskID
cmsApplication.Servers.Remove cmsServer.ServerKey
End If
' Logs out
cmsReport.Quit
cmsConnection.Logout
cmsConnection.Disconnect
cmsServer.Connected = False
' Releases objects
Set cmsReport = Nothing
Set cmsCatalog = Nothing
Set cmsConnection = Nothing
Set cmsServer = Nothing
Set cmsApplication = Nothing
Next
i = Nothing
DayToRun = DateAdd("d", 1, DayToRun)
Wend
EndRunTime = Now
MsgBox ("Run-time = " & Minute(EndRunTime - StartRunTime) & ":" & Second(EndRunTime - StartRunTime))
End Sub