The problem is on line fourteen. Else is somehow a syntax error, (800A03EA) I'm very new to VBScript.
Dim StrThing, fso, f
Const ForReading = 1, ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
If f.FileExists("Desktop\testfile") then
StrThing=InputBox("Type your name in")
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForWriting, True)
f.WriteLine "Hello world!"
f.WriteLine "Hello, " & StrThing
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForReading)
WriteLineToFile = f.ReadAll
StrThing=MsgBox("Hello, " & StrThing)
StrThing=MsgBox("Goodbye, " & StrThing)
End if
Else
x=MsgBox("Hello")
f.createTextFile
StrThing=InputBox("Type your name in")
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForWriting, True)
f.WriteLine "Hello world!"
f.WriteLine "Hello, " & StrThing
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForReading)
WriteLineToFile = f.ReadAll
StrThing=MsgBox("Hello, " & StrThing)
StrThing=MsgBox("Goodbye, " & StrThing)
End if
Two changes required here.
else statement started after closing if
f.FileExists ← No object defined for f.
Modified code:
Dim StrThing, fso, f
Const ForReading = 1, ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = CreateObject("Scripting.FileSystemObject")
If f.FileExists("Desktop\testfile.txt") then
StrThing=InputBox("Type your name in")
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForWriting, True)
f.WriteLine "Hello world!"
f.WriteLine "Hello, " & StrThing
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForReading)
WriteLineToFile = f.ReadAll
StrThing=MsgBox("Hello, " & StrThing)
StrThing=MsgBox("Goodbye, " & StrThing)
Else
x=MsgBox("Hello")
f.createTextFile
StrThing=InputBox("Type your name in")
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForWriting, True)
f.WriteLine "Hello world!"
f.WriteLine "Hello, " & StrThing
Set f = fso.OpenTextFile("Desktop\testfile.txt", ForReading)
WriteLineToFile = f.ReadAll
StrThing=MsgBox("Hello, " & StrThing)
StrThing=MsgBox("Goodbye, " & StrThing)
End if
Related
Here is the code which I have written in vb6...it is showing error in text1.setfocus
Private Sub Text1_Lostfocus()
s1 = Text1.Text
flag = 0
If Text1.Text = "" Then
flag = 1
End If
For i = 1 To Len(s1)
l = Mid(s1, i, 1)
If IsNumeric(l) = True Then
flag = 1
Exit For
End If
Next i
If flag = 1 Then
MsgBox "Enter valid input"
Text1.ForeColor = vbRed
Text1.SetFocus
End If
End Sub
Do not have this code in LostFocus, instead try to have it in the Validate event, there would be an cancel parameter to the event, if you set Cancel = True (means the cursor will not exit the control) you need not do setfocus
Try the following:
Private Sub Text1_Validate(Cancel As Boolean)
If IsNumeric(Text1.Text) = False Then
MsgBox "Enter valid input"
Text1.ForeColor = vbRed
Cancel = True
End If
End Sub
Try this if you have an empty string and you are trying to work with in in your loop you can get an invalid procedure call. skip over it all togehter don't run the loop if the text is empty.
Private Sub Text1_Lostfocus()
s1 = Text1.Text
flag = 0
If Text1.Text = "" Then
flag = 1
else
For i = 1 To Len(s1)
l = Mid(s1, i, 1)
If IsNumeric(l) = True Then
flag = 1
Exit For
End If
Next i
endif
If flag = 1 Then
MsgBox "Enter valid input"
Text1.ForeColor = vbRed
Text1.SetFocus
End If
End Sub
How to Sort String with Numeric values using VB Script?
Below are my strings from each row from a table:
"Test 1 pass dec 2"
"Test 3 fail"
"Test 2 pass jun 4"
"Verified"
"Test 10 pass"
"User Accepted"
I would to like get in below order after sorting(natural order):
"Test 1 pass dec 2"
"Test 2 pass jun 4"
"Test 3 fail"
"Test 10 pass"
"User Accepted"
"Verified"
Ways i have tried so far,
Set oAlist=CreateObject("System.Collections.ArrayList")
oAlist.sort
The ArrayList was sorted in below order based on ASCII which I do not prefer:
"Test 1 pass dec 2"
"Test 10 pass"
"Test 2 pass jun 4"
"Test 3 fail"
"User Accepted"
"Verified"
I have tried this link Sort
and i have no idea how to use AppendFormat in my case.
Note:My given string either completely string or string with numbers(dynamic) so not sure how to use RecordSet or AppendFormat here as I am new to programming.
You can have another example.
Sub Sort
Set rs = CreateObject("ADODB.Recordset")
If LCase(Arg(1)) = "n" then
With rs
.Fields.Append "SortKey", 4
.Fields.Append "Txt", 201, 5000
.Open
Do Until Inp.AtEndOfStream
Lne = Inp.readline
SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
If IsNumeric(Sortkey) = False then
Set RE = new Regexp
re.Pattern = "[^0-9\.,]"
re.global = true
re.ignorecase = true
Sortkey = re.replace(Sortkey, "")
End If
If IsNumeric(Sortkey) = False then
Sortkey = 0
ElseIf Sortkey = "" then
Sortkey = 0
ElseIf IsNull(Sortkey) = true then
Sortkey = 0
End If
.AddNew
.Fields("SortKey").value = CSng(SortKey)
.Fields("Txt").value = Lne
.UpDate
Loop
If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
.Sort = SortColumn
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
ElseIf LCase(Arg(1)) = "d" then
With rs
.Fields.Append "SortKey", 4
.Fields.Append "Txt", 201, 5000
.Open
Do Until Inp.AtEndOfStream
Lne = Inp.readline
SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
If IsDate(Sortkey) = False then
Set RE = new Regexp
re.Pattern = "[^0-9\\\-:]"
re.global = true
re.ignorecase = true
Sortkey = re.replace(Sortkey, "")
End If
If IsDate(Sortkey) = False then
Sortkey = 0
ElseIf Sortkey = "" then
Sortkey = 0
ElseIf IsNull(Sortkey) = true then
Sortkey = 0
End If
.AddNew
.Fields("SortKey").value = CDate(SortKey)
.Fields("Txt").value = Lne
.UpDate
Loop
If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
.Sort = SortColumn
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
ElseIf LCase(Arg(1)) = "t" then
With rs
.Fields.Append "SortKey", 201, 260
.Fields.Append "Txt", 201, 5000
.Open
Do Until Inp.AtEndOfStream
Lne = Inp.readline
SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
.AddNew
.Fields("SortKey").value = SortKey
.Fields("Txt").value = Lne
.UpDate
Loop
If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
.Sort = SortColumn
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
ElseIf LCase(Arg(1)) = "tt" then
With rs
.Fields.Append "SortKey", 201, 260
.Fields.Append "Txt", 201, 5000
.Open
Do Until Inp.AtEndOfStream
Lne = Inp.readline
SortKey = Trim(Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3))))
.AddNew
.Fields("SortKey").value = SortKey
.Fields("Txt").value = Lne
.UpDate
Loop
If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
.Sort = SortColumn
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
End If
End Sub
Since you are working with strings, you are going to need to write a custom sort function that can parse the test numbers from the strings.
Alternatively, you could pre-process your list and parse the numbers into a separate field, then sort based on that field.
To apply the techniques from here to the problem (using Split instead of a RegExp):
Option Explicit
Dim aInp : aInp = Array( _
"Test 1 pass dec 2" _
, "Test 3 fail" _
, "Test 2 pass jun 4" _
, "Verified" _
, "Test 10 pass" _
, "User Accepted" _
)
WScript.Echo "----- Input:", vbCrLf & Join(aInp, vbCrLf)
Dim aOtp : aOtp = Array( _
"Test 1 pass dec 2" _
, "Test 2 pass jun 4" _
, "Test 3 fail" _
, "Test 10 pass" _
, "User Accepted" _
, "Verified" _
)
WScript.Echo "----- Expected:", vbCrLf & Join(aOtp, vbCrLf)
Dim oNAL : Set oNAL = CreateObject( "System.Collections.ArrayList" )
Dim oSB : Set oSB = CreateObject( "System.Text.StringBuilder" )
Dim sInp, aParts, aWTF
For Each sInp In aInp
aParts = Split(sInp, " ", 3)
Select Case UBound(aParts)
Case 0 ' add 2 blank elms to "verified"
aWTF = aParts
ReDim Preserve aWTF(2)
Case 1 ' put an empty elm in the middle
' aParts = Array( aParts(0), "", aParts(1))
' ==> VBScript runtime error: This array is fixed or temporarily locked
aWTF = Array( aParts(0), "", aParts(1))
Case 2 ' What the doctor ordered
aWTF = aParts
Case Else
Err.Raise "Shit hits fan"
End Select
oSB.AppendFormat_3 "{0}{1,4}{2}", aWTF(0), aWTF(1), aWTF(2)
sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data th ease 'reconstruction'
oSB.Length = 0
oNAL.Add sInp
Next
oNAL.Sort
ReDim aOut(oNAL.Count - 1)
Dim i
For i = 0 To UBound(aOut)
aOut(i) = Split(oNAL(i), "|")(1)
Next
WScript.Echo "----- Output:", vbCrLf & Join(aOut, vbCrLf)
output:
cscript 37946075.vbs
----- Input:
Test 1 pass dec 2
Test 3 fail
Test 2 pass jun 4
Verified
Test 10 pass
User Accepted
----- Expected:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified
----- Output:
Test 1 pass dec 2
Test 2 pass jun 4
Test 3 fail
Test 10 pass
User Accepted
Verified
Just for fun: The 'same', but using a RegExp (better scaling technique):
...
Dim r : Set r = New RegExp
r.Pattern = "^(\w+\s*)(\d+\s*)?(.*)$"
Dim sInp, m, aParts(2)
Dim i
For Each sInp In aInp
Set m = r.Execute(sInp)
If 1 = m.Count Then
For i = 0 To 2
aParts(i) = m(0).SubMatches(i)
Next
Else
Err.Raise "Shit hits fan"
End If
oSB.AppendFormat_3 "{0}{1,4}{2}", aParts(0), aParts(1), aParts(2)
sInp = oSB.ToString() & "|" & sInp ' dirty trick: append org data to ease 'reconstruction'
...
I'm using a .hta which carries a list of words in a text file the problem occurs when this file has 0kb... how I would do so if the file has the size 0kb not of an error and load the blank file?
My Code:
<script type="text/vbscript">
Option Explicit
Window.resizeTo 373,610
Const csFSpec = "MyList.TxT"
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Sub Window_OnLoad()
If goFS.FileExists(csFSpec) Then
document.all.DataArea.value = goFS.OpenTextFile(csFSpec).ReadAll()
Else
self.close
End If
If document.all.DataArea.value =vbcrlf Then
document.all.DataArea.value =""
Else
End If
End Sub
Sub SaveFile()
If document.all.DataArea.value = "" Then
document.all.DataArea.value =vbcrlf
goFS.CreateTextFile(csFSpec).Write document.all.DataArea.value
self.close
Else
document.all.DataArea.value = Replace(document.all.DataArea.value, "\", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "/", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, ":", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "*", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "?", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, """", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "<", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, ">", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "|", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "&", "_")
document.all.DataArea.value = Replace(document.all.DataArea.value, "!", "_")
goFS.CreateTextFile(csFSpec).Write document.all.DataArea.value
DIM objFSO
DIM objFile
DIM STRLINE
DIM STRNEWCONTENTS
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("MyList.TxT", ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If Len(strLine) > 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile("MyList.TxT", ForWriting)
objFile.Write strNewContents
objFile.Close
document.all.DataArea.value = goFS.OpenTextFile(csFSpec).ReadAll()
document.all.DataArea.value = Replace(document.all.DataArea.value, vbcrlf,"|")
document.all.DataArea.value = left(document.all.DataArea.value,len(document.all.DataArea.value)-1)
document.all.DataArea.value = Replace(document.all.DataArea.value,"|",vbcrlf)
goFS.CreateTextFile(csFSpec).Write document.all.DataArea.value
self.close
End if
End Sub
Sub QuitEdit()
self.close
End Sub
Sub Redefine()
document.all.DataArea.value ="CD" & vbcrlf & "Album" & vbcrlf & "Song" & vbcrlf & "DJ" & vbcrlf
End Sub
Sub Clean()
document.all.DataArea.value = ""
End Sub
</script>
Test .size after verifying file existence (not tested):
If goFS.FileExists(csFSpec) Then
SET objFile = goFS.GetFile(csFSpec)
If objFile.Size > 0 Then
document.all.DataArea.value = goFS.OpenTextFile(csFSpec).ReadAll()
Else
'Do something else
End If
Else
I read a really helpful post here How do I make the first letter of a string uppercase in JavaScript? and I was curious of a good solution using VBScript.
>> s = "first word of string"
>> WScript.Echo UCase(Left(s, 1)) & Mid(s, 2)
>>
First word of string
str = "mY nAME iS sACHIN"
arrStr = split(str," ")
For i=0 to ubound(arrStr)
word = lcase(trim(arrStr(i)))
word = replace(word,mid(word,1,1),chr(asc(mid(word,1,1))-32),1,1)
str1 = str1 & word & " "
next
msgbox trim(str1)
Output: My Name Is Sachin
str = "mY nAME iS sACHIN"
arrStr = split(str," ")
For i=0 to ubound(arrStr)
word = lcase(trim(arrStr(i)))
word = replace(word,mid(word,1,1),ucase(mid(word,1,1)),1,1)
str1 = str1 & word & " "
next
msgbox trim(str1)
Currently I am working on vb6 application. I want to show data in MSFlexgrid But there is no edit Facility in MSFlexgrid Control.
Is there Any way to Edit MSFlexgrid?
There is a way using hidden Textbox. On the double click on the cell the textbox will be visible and Edit is possible here is code snippet check it
Private Sub Form_Load()
'Setting Col And row
MSFlexGrid1.Cols = 3
MSFlexGrid1.Rows = 10
'First row
MSFlexGrid1.TextMatrix(0, 0) = "ID"
MSFlexGrid1.TextMatrix(0, 1) = "Date"
MSFlexGrid1.TextMatrix(0, 2) = "Voucher Type"
'some data
MSFlexGrid1.TextMatrix(1, 0) = "E0000001"
MSFlexGrid1.TextMatrix(2, 0) = "E0000001"
MSFlexGrid1.TextMatrix(1, 1) = "01/04/10"
MSFlexGrid1.TextMatrix(2, 1) = "01/04/10"
MSFlexGrid1.TextMatrix(1, 2) = "Jrnl"
MSFlexGrid1.TextMatrix(2, 2) = "Jrnl"
End Sub
Private Sub MSFlexGrid1_DblClick()
'If MSFlexGrid1.Col = 3 Or MSFlexGrid1.Col = 6 Or MSFlexGrid1.Col = 7 Then
GridEdit Asc(" ")
'End If
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
GridEdit KeyAscii
End Sub
Sub GridEdit(KeyAscii As Integer)
'use correct font
Text1.FontName = MSFlexGrid1.FontName
Text1.FontSize = MSFlexGrid1.FontSize
Select Case KeyAscii
Case 0 To Asc(" ")
Text1 = MSFlexGrid1
Text1.text = Trim(Text1.text)
Text1.SelStart = 1000
Case Else
Text1 = MSFlexGrid1
Text1.text = Trim(Text1.text)
Text1.SelStart = 1000
End Select
'position the edit box
Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
Text1.Width = MSFlexGrid1.CellWidth
Text1.Height = MSFlexGrid1.CellHeight
Text1.Visible = True
Text1.SetFocus
End Sub
Private Sub MSFlexGrid1_LeaveCell()
If Text1.Visible Then
If MSFlexGrid1.Col = 6 Or MSFlexGrid1.Col = 7 Then
If Text1.text = "" Then
Text1.text = " "
End If
End If
MSFlexGrid1 = Text1
Text1.Visible = False
End If
End Sub
Private Sub MSFlexGrid1_GotFocus()
If Text1.Visible Then
If MSFlexGrid1.Col = 6 Or MSFlexGrid1.Col = 7 Then
If Text1.text = "" Then
Text1.text = " "
End If
End If
MSFlexGrid1 = Text1.text
Text1.Visible = False
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'noise suppression
If MSFlexGrid1.Col <> 6 And MSFlexGrid1.Col <> 7 Then
KeyAscii = 0
End If
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
End If
End Sub
Can you also try below code. This doesnt require text box.
'Put this code in MSFlexGrid Keypress Event
'===================================================
Private Sub MSFlexGrid_KeyPress(KeyAscii As Integer)
With MSFlexGrid
Select Case KeyAscii
Case 8: 'IF KEY IS BACKSPACE THEN
If .Text <> "" Then .Text = _
Left$(.Text, (Len(.Text) - 1))
Case 13: 'IF KEY IS ENTER THEN
Select Case .Col
Case Is < (.Cols - 1):
SendKeys "{right}"
Case (.Cols - 1):
If (.Row + 1) = .Rows Then
.Rows = .Rows + 1
End If
SendKeys "{home}" + "{down}"
End Select
Case Else
.Text = .Text + Chr$(KeyAscii)
'write your own keyascii Validations under
'commented lines
Select Case .Col
Case 0, 1, 2:
'if (your condition(s)) then
'accept only charectors
'Else
' keyascii=0
'End If
Case Else:
End Select
End Select
End With
End Sub