in Access 2010 (x64) I have a method declared in a class module as below:
Public Sub addFieldAndValueToXML(fieldName As String, value As String)
xmlStr = xmlStr & "<field name=""" & fieldName & """><value>" & value & "</value></field>"
End Sub
I call it from a method on a form as below:
For i = 0 To 4
If Not .EOF Then
Dim n As Integer
n = i + 1
'Stop
builder.addFieldAndValueToXML "FINDINGS Include applicable referencesRow" & n, Nz(!FIndings, "")
Select Case !RatingID
Case 1
builder.addFieldAndValueToXML "MAJORRow" & n, "X"
builder.addFieldAndValueToXML "MINORRow" & n, ""
Case 2
builder.addFieldAndValueToXML "MAJORRow" & n, ""
builder.addFieldAndValueToXML "MINORRow" & n, "X"
Case Else
builder.addFieldAndValueToXML "MAJORRow" & n, ""
builder.addFieldAndValueToXML "MINORRow" & n, ""
End Select
builder.addFieldAndValueToXML "FOCUS AREARow" & _
n, Left(DLookup("Discrepancy_Type", "DiscrepancyType_Tbl", "DiscrepancyTypeID =" & !DiscrepancyTypeID), 1)
.MoveNext
End If
Next i
The purpose of the code is to build an xml string that is output to a .xfdf file, and it appears to be working fine except for the lines where fieldName is given the value "MAJORRow".
When I step through the code I can see that the lines prior to, and after the offending lines call the method properly, and I can see the fieldName and value arguments being populated properly.
However on the offending lines, fieldName is not being populated at all, whereas value is.
I've tried a number of different values for fieldName ("majorrow", "maj_row", "MAJ_Row", etc.) and when the combination "AJ" (has to be capitalized) is in the string, it fails to populate fieldName.
I've checked for reserved words, and done a fair bit of searching but can find nothing relating to this at all. Has anyone else come across this?
I'm running Windows 10 (x64).
Cheers.
Related
I do a function to assign an ID. But when I click button, this error comes out.
Microsoft VBScript runtime error '800a000d' Type mismatch: 'LastID'
Public function AssignSanctionID(DeptID,SectID,SanctionType)
REM obtain Transaction ID
dim CmdX
dim SQLX
dim RsX
dim Prefix
dim LastID
dim CurrID
dim NewCurrID
'- Set Connection
HariNi=now()
Tahun=year(HariNi)
Bulan=month(HariNi)
if len(bulan)=1 then
Bulan= "0" & Bulan
end if
If Cint(Tahun) < 2016 then
Pref1= DeptID & "/" & SectID & "/"
Prefix=DeptID & "/" & SectID & "/" & Tahun & "/" & Bulan & "/"
else
Pref1= DeptID & "/%/" & SectID
Prefix=DeptID & "/" & Tahun & "/" & Bulan & "/"
end if
set CmdX = server.CreateObject("ADODB.Command")
Set RSX = Server.CreateObject("ADODB.Recordset")
SQLX = " SELECT * FROM Sanction " _
& " WHERE SanctionID like '%" & Pref1 & "%' " _
& " ORDER BY ID DESC"
CmdX.ActiveConnection = objconn
CmdX.CommandText = SQLX
RsX.Open CmdX,,0,1
if not(RsX.BOF and RsX.EOF) then
If Cint(Tahun) < 2016 then
LastID = right(RsX("ID"),4)
else
LastID = mid(RsX("ID"),13,4)
end if
else
if Bulan="04" then
LastID=0
end if
end if
RsX.Close
set RsX = nothing
'Set ID
If LastID<>"" then
'CurrID = left(4)
CurrID=int(LastID)+1
end if
if len(currid)>0 then
select case len(currid)
case 1
newcurrid = "000" & currid
case 2
newcurrid = "00" & currid
case 3
newcurrid = "0" & currid
case 4
newcurrid = currid
end select
else
NewCurrID="0001"
end if
If Cint(Tahun) < 2016 then
NewCurrID=Prefix & NewCurrID
else
NewCurrID=Prefix & NewCurrID & "/" & SectID
end if
AssignSanctionID = NewCurrID
end function
Hard to help if I don't see the data.
From quick view of the code the issue is here:
CurrID=int(LastID)+1
You are trying to cast LastID but are you sure that it is convertible? Could list all possible values?
Short answer: CInt only works with Numerical values. If you have letters in your value, then Cint wont work.
Bit longer answer:
Having read the Blog that we should be more welcoming (https://stackoverflow.blog/2018/04/26/stack-overflow-isnt-very-welcoming-its-time-for-that-to-change/?cb=1), here is a very general answer, but that might lead you on the correct way to fix it yourself.
Type Mismatch is an error you can get when using a variable the wrong way. For example if you try to do numerical functions with Strings (which means the variable contains letters a-z etc) you will get "Type Mismatch" as you cant add or subtract text in a mathematical way... On the other hand you cant add Integer variables (the variable only contains a number AND isnt contained within "quote marks").
So below is a few ways to assigna a variable and what type it becomes:
LastID=1 'This makes LastID an INT (number)
LastID="1" 'This makes LastID a String but a CInt(LastID) can turn it into an INT because it ONLY contains numbers.
LastID="IT" 'This makes LastID a String that CANT in any way be cast to INT as it contains letters.
LastID=IT 'This row will either create an error except if you already have a variable called IT, then LastID will get the same value as the IT variable...
This should hopefully get you on your way to fix this issue...
hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)
I was working on a system in VBA word. The goal of the system is to replace several different words in a document with input from a text box. So far I have a userform with 12 different text boxes each containing input from a user to replace words in the document. I made a button in the userform to print all the input from the textboxes to the document.
For each textbox I made the following code:
Sub FindAndReplaceAllStoriesHopefully()
Dim myStoryRange As Range
'
'
'Loop replaces everything with <KLANTNAAM> in the document
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Loop
Next myStoryRange
So far I did this for all 12 textboxes and it works but it isn't smooth. The
button upon getting clicked is calling the function with
Call FindAndReplaceAllStoriesHopefully
I have a few problems which I just cannot fix:
Once the button is clicked and some textboxes are not filled by the user, the marked words like <KLANTNAAM> are still replaced and removed from the document.
The performance of the macro is not great since the same code is copied 12 times.
Once the button is clicked, there is no easy way for the user to undo mistakes typed in the userform since the results are already printed.
I was hoping to get some tips so I can finalize this application.
Something like this:
Private Sub CommandButton1_Click()
Dim numBlank As Long, n As Long, txt As String
Dim bookMarkName As String
numBlank = Me.CountBlanks
If numBlank > 0 Then
If MsgBox(numBlank & " entries are blank!. Continue?", _
vbExclamation + vbOKCancel) <> vbOK Then
Exit Sub
End If
End If
For n = 1 To 4
txt = Me.Controls("Textbox" & n).Text
bookMarkName = "BOOKMARK" & n
FindAndReplaceAllStoriesHopefully bookMarkName, txt
Next n
End Sub
Function CountBlanks() As Long
Dim n As Long, b As Long
b = 0
For n = 1 To 4
If Len(Me.Controls("Textbox" & n).Text) = 0 Then
b = b + 1
End If
Next n
CountBlanks = n
End Function
I have a Recordset obtained by the following query:
SELECT DISTINCT [Number] FROM NUMBERS WHERE CODE = 7 ORDER BY [Number]
The Recordset will therefore be a list of ordered numbers, eg. [6,14,37,59,81,145]
I would like to generate a long string of numbers made up of only 0s and 1s, where it is all 0s except in positions designated by the numbers in the recordset: eg. 6,14,37,59, etc.
The result would therefore look something like:
000000000000000000100000000000000000000001000000000000000000001000000 etc
Assuming that rs is the Recordset, I have the following code so far. Would this work?
intLower = 1
While Not (rs.BOF Or rs.EOF)
intUpper = rs!Number
For intSlot = intLower To intUpper
strOutput = strOutput & IIf(rs!Number = intSlot, 1, 0)
Next intSlot
rs.moveNext
intLower = intUpper + 1
Wend
Note: I realise this is similar to an earlier question of mine, but I am now asking how to do this when the numbers are contained in a Recordset. Also note that I do not want to use a function that converts a recordset to an array, because I am using DAO and apparently the GetRows is problematic.
How about;
dim value as long
dim result as String
do while not rs.EOF
value = rs!Number
If (value > Len(result)) then result = result & String$(value - Len(result), "0")
Mid$(result, value, 1) = "1"
rs.moveNext
loop
msgbox result
Edit as they are sorted;
dim result as String
do while not rs.EOF
result = result & String$(rs!Number - Len(result) - 1, "0") & "1"
rs.moveNext
loop
msgbox result
DISCLAIMER: I'm still an uber-n00b with programming concepts and know just enough VBS to hurt myself, so I'm likely to slur/slaughter some of the terms/concepts/ideas that are entailed with this program I'm trying to write. You, the vastly superior programmer who has every right to flame me, have been warned.
I've been trying to write a VBScript to validate data, specifically Dates. Since my users are kind of poor with keyboards, I figured I'd make it easy by separating the entry of each part of the date (Month & Day only, I've got the Year set statically).
Previously, I was having problems with validating the numbers with only 1 "Do...Loop", as I was trying to verify if it was Numeric Input and checking at the same time if it was within the specified range (1 - 12, for the 12 months of the year).
This is what the previous code roughly looked like:
Do
' If...Then Statements Here
Loop Until (dtFirstMonth > 0) _
And (dtFirstMonth < 13) _
And IsNumeric(dtFirstMonth) _
And (dtFirstMonth <> "") _
And (dtFirstMonth <> vbNull)
This often resulted in "Data Type Mismatch" errors, so I had to split the Validation Critera to two separate "Do...Loop" statements, as you can see in the current code I have below:
Sub srTest()
Do
dtFirstMonth = InputBox("Please Enter a Numeric Month for the Starting Range", _
"Starting Range Month")
If (dtFirstMonth = vbNull) _
Or (dtFirstMonth = "") _
Or Not IsNumeric(dtFirstMonth) Then
MsgBox "Please Enter a Valid Numeric Month",, "Enter Month Number"
ElseIf (dtFirstMonth <> vbNull) _
And (dtFirstMonth <> "") _
And IsNumeric(dtFirstMonth) Then
Do
dtFirstMonth = Round(dtFirstMonth)
Wscript.Echo dtFirstMonth ' Infinite Loop Here (Basically, As Soon As We Get Into Loop with a Value of 1, We're Stuck)
dtFirstMonth = CInt(dtFirstMonth)
' Must Convert User Input to Integer to
' Prevent Data Mismatch Errors In
' Following "If" Statement; Besides,
' It Passed the First Test to be a
' Numeric Value in the First Place
If (dtFirstMonth < 1) Or (dtFirstMonth > 12) Then
MsgBox "Please Enter a Valid Numeric Month",, "Enter Month Number"
Exit Do
' Drop Out of 2nd Level Loop to
' Enter Into 1st Level Loop
End If
Loop Until (dtFirstMonth > 0) _
And (dtFirstMonth < 13) _
And IsNumeric(dtFirstMonth) _
And (dtFirstMonth <> "") _
And (dtFirstMonth <> vbNull)
If (dtFirstMonth < 1) Or (dtFirstMonth > 12) Then
dtFirstMonth = ""
End If
' dtFirstMonth Was Converted to Integer Earlier
' This is to Meet the Value that Didn't Pass
' the Nested Do & If Statement (Level 2 Do Loop)
' Sets dtFirstMonth to "Empty String" to Continue
' Looping in the Level 1 "Do...Loop" Statement;
' If Omitted, Level 1 "Do...Loop" is Satisfied,
' Thus Ending the Subroutine (Since the Value
' of dtFirstMonth is Still a Numeric Value)
End If
Loop Until IsNumeric(dtFirstMonth) _
And (dtFirstMonth <> "") _
And (dtFirstMonth <> vbNull)
Wscript.Echo dtFirstMonth
End Sub
srTest
I had to set up the 1st "Do...Loop" to check that the User Input (dtFirstMonth) was a indeed a Numeric Value and not a Null Value nor an Empty String. The Nested "Do...Loop", or 2nd "Do...Loop", statement is where I have the same Criteria plus the extra Criteria defining the desired ranges (any number between 1 and 12).
This is working perfectly for number 2-12, but when the script parses the number 1, I enter into an Infinite Loop.
I've checked to make sure that the Infinite Loop is occurring in the 2nd "Do...Loop" by replacing the entire 2nd "Do...Loop" section with "Wscript.Echo dtFirstMonth". By doing this, I get the expected results: a single Echo, not an infinite number of them (technically, I get 2, as I do have another "Wscript.Echo dtFirstMonth" string at the bottom of the Subroutine for the purpose of debugging, but either way, it's not an Infinite Loop).
I've also changed the criterion for the lower range to be like this, yet this doesn't remediate the error:
Do
' If...Then Statements Here
Loop Until (dtFirstMonth >= 1)
I've also tried this, with no resulting success:
Do
' If...Then Statements Here
Loop Until (dtFirstMonth >= CInt(1))
In all reality, there really is no need for this segment, since I converted the User's Input to an integer anyway.
Since this was starting to get confusing, I decided to add the "Round" statement before the script passed the User's Input to the "CInt" function, hoping that it would make sure that it wasn't getting caught as a 0 value or decimal value somehow; yes, this is irrational thought on my part, but I still wanted to explore all avenues (there's also the fact that I have some users with "Fat Finger Syndrome" and some others with "Abuse The Program" mentality, so I figured I'd make sure the script accounted for decimal entries). I added the "Round" string before and after the nested "Do...Loop" and I still had the Infinite Loop issue.
This is as far as I've been able to get on this and now I'm stuck.
I realize that there are likely better ways to do Date/Time Validation in VBScript, and I'm certainly open to any new suggestions, but I'd love to solve this for the pure sake of edification.
Way too much code for a simple input of a number. Just try to keep it short and simple. Example:
Do
dtm = InputBox("Please Enter a Numeric Month for the Starting Range", _
"Starting Range Month")
Select Case True
Case isNull(dtm), (not isNumeric(dtm)), dtm = "", dtm = empty, (dtm < 1 OR dtm > 12)
' too exhaustive, but just for the sake of the example.
MsgBox "Please enter an amount between 1 and 12"
Case else
' Hey, this seems to be a valid amount!
Exit do
End Select
Loop While True
' Do something with dtm
Just showed you some creative Select Casing, this supports lazy exit, so if a value is Null, it escapes before getting evaluated where evaluating could throw an error.
The problem is with your attempt to check for null values:
(dtFirstMonth = vbNull)
The proper way to check for nulls, as demonstrated in AutomatedChaos' answer, is with the IsNull function. vbNull is actually a constant that's used with the VarType function. The value of vbNull is 1, which is why that particular value behaved differently from other entries. That's the fundamental problem, and if you replace every dtFirstMonth = vbNull with IsNull(dtFirstMonth), you won't get an infinite loop when entering 1.
Now, the actual place where your code infinitely loops is interesting. I would expect the first conditional If (dtFirstMonth = vbNull) to evalute true for an entry of "1", and you would get the message box "Please enter a valid numeric month". However, the Else condition is triggered. This is weird because normally, when you compare a string to a number, VBScript will attempt to convert the number to a string or vice versa, so if dtFirstMonth is "1", it should be equal to vbNull (which is 1). However, there appears to be a special case when you compare a string variable to an integer variable. See this example:
' vbNull = 1, built-in constant
dtFirstMonth = "1"
MsgBox (dtFirstMonth = vbNull) ' False
MsgBox ("1" = vbNull) ' True
MsgBox (dtFirstMonth = 1) ' True
MsgBox (CInt(dtFirstMonth) = vbNull) ' True
I don't know if this is a bug or just an obscure detail about VBScript's implicit conversion, but it does illustrate that implicit conversion can be unpredictable in VBScript.
As far as alternative methods go, you may be interested in the IsDate function, which returns True if the given expression can be converted into a date. It may not be ideal for your users and their keyboard skills, but it would reduce your code to:
Do
str = InputBox("Enter a date (MM/DD)")
If IsDate(str) Then
Exit Do
Else
WScript.Echo "Please enter a valid date"
End If
Loop
dt = CDate(str)
' Put your static year here; CDate will default to the current year
dtActual = DateSerial(2007, Month(dt), Day(dt))
WScript.Echo (dtActual) & " - Thanks!"
Note that IsDate should return False for the typical edge cases ("", Null, Empty, etc.), so there's no need for a separate check.
I found a simple program to generate Date and time from http://rindovincent.blogspot.com/p/vbscript-programs.html. I am pasting the same program with permission.
<html>
<body>
<center>
<script type="text/vbscript">
d=CDate("October 22, 2010")
document.write(d&"<br/>")
document.write("Current system date is:"&date&"<br/>")
document.write("Current system time is:"&time&"<br/>")
document.write(DatePart("m",Now())&"<br/>")
document.write(DateAdd("yyyy",1,"31-Jan-10") & "<br />")
document.write(MonthName(10,true)& "<br />")
fromDate="22-sep-10 00:00:00"
toDate="21-oct-10 23:59:00"
document.write(DateDiff("m",fromDate,toDate)&"<br />")
document.write(DateDiff("y",fromDate,toDate) & "<br />")
document.write(DateDiff("w",fromDate,toDate) & "<br />")
document.write(DateDiff("h",fromDate,toDate) & "<br />")
</script>
</center>
</body>
</html>