At the moment, I have three different times that the following code is ran, back-to-back just with the variables changed:
txtCourseName.LoadFile(strRootLocation + "\subject\" + strSubject + "\" + "\class\" + cmbCourses.SelectedItem, RichTextBoxStreamType.PlainText)
aData = txtCourseName.Text
i = aData.IndexOf("<h3 class=""panel-title"">") + "<h3 class=""panel-title"">".Length
j = aData.IndexOf("</h3>") - i
txtCourseName.Text = aData.Substring(i, j)
For every time it is ran, the rich-text box that is being used is changed, aData is changed to bData, cData, etc., and the data that i and j are indexing is changed. It will run properly for the first two iterations, returning what it is supposed to into the text box, however on the third one, it gives me a System.ArgumentOutOfRangeException with the additional information of Length cannot be less than zero.
My only assumption for what could be causing this is that the third iteration, which I included below, is only supposed to find a 7-letter long string of characters and this is causing some math issues.
I have no idea how to fix this.
txtCourseNumber.LoadFile(strRootLocation + "\subject\" + strSubject + "\" + "\class\" + cmbCourses.SelectedItem, RichTextBoxStreamType.PlainText)
cData = txtCourseNumber.Text
i = cData.IndexOf("Course Number: </b>") + "Course Number: </b>".Length
j = cData.IndexOf("</li>") - i
txtCourseNumber.Text = cData.Substring(i, j)
Example Data That Is Returned By Each Iteration
aData - "English 4"
bData - "insert some really long course description here"
cData - "10045C"
Related
I am writing a code where I have a for loop in which I give a variable (named VType ) some value. For loop goes for a range of i variables. Now I want to make a new variable by concatenating names of both variables. for example if i = 1 then I want to make variable VType1. Here is my piece of code.
nrec = Split(Split(ie.document.body.innerHTML, "Found <strong>")(1), "</strong> records")(0)
If nrec = 1 Then
lnk.Click
Else
For j = 1 To nrec
link.Click
Do While ie.readyState <> 4: Wait 5: Loop
Application.Wait (Now + TimeValue("0:00:01"))
'VType , j = GetType
'Application.Wait (Now + TimeValue("0:00:01"))
IMO , j = GetValue("IMO:")
'MMSI = GetValue("MMSI:")
YBuilt , j = GetValue("Year Built:")
Flag , j = GetValue("Flag:")
DWT , j = GetValue("Deadweight:")
Next j
num = "1 - " & IMO1
For i = 2 To nrec
num = num & vbCrLf & i & "abc"
Next I
fin = InputBox(num, nrec & " records found for a. please select right one.")
Exit For
End If
There is not a way to directly do what you're specifically requesting. However, you can use arrays to get a similar outcome. Arrays are a not a topic that can be explained in a single posted answer, but if you do a little research you can probably figure out how the below might be useful...
Dim VTtyp(0 to i) as string
'while Looping...
Vtype(i) = "Whatever you want stored in this round of i"
When your code completes, you'll have all fields saved as variables that can be called from this array. An example is if you wanted to call the one that was tied to the number "2" you could type: Vtype(2) and it would call the text from the 2 iteration.
Again this example is extremely simplified and there are things to consider such as dim size, changing the dim, preserving the array, etc. and that is something you'll have to research further. However bottom line is, "there is not a way to do what you're specifically trying to do."
You can achieve this using Dictionary objects concept. Go through the below link to know more about dictionary objects.
https://www.tutorialspoint.com/vbscript/vbscript_dictionary_objects.htm
So I'm writing a piece of code that has the goal of taking, for example, coding #codez code #coderino and turning it into coding #CODEZ code #CODERINO.
It works just fine if I only have one # in the phrase, eg. coding #codez code turns into coding #CODEZ code.
However, if I have more than one # in the phrase, such as in the first example, it ignores the loop and makes nothing uppercase, or simply breaks.
Here's the piece of code that I'm having an issue with:
Do Until CurrentPositionOfAtSymbol = -1
CurrentPositionOfAtSymbol = StartingTweet.IndexOf("#", CurrentPositionOfSpace + 1)
CurrentPositionOfSpace = StartingTweet.IndexOf(" ", CurrentPositionOfAtSymbol)
TempName = StartingTweet.Substring(CurrentPositionOfAtSymbol + 1, CurrentPositionOfSpace - CurrentPositionOfAtSymbol - 1)
TempNameUppercase = TempName.ToUpper
StartingTweet = StartingTweet.Remove(CurrentPositionOfAtSymbol + 1, CurrentPositionOfSpace - CurrentPositionOfAtSymbol - 1)
StartingTweet = StartingTweet.Insert(CurrentPositionOfAtSymbol + 1, TempNameUppercase)
CurrentPositionOfAtSymbol = StartingTweet.IndexOf("#", CurrentPositionOfSpace + 1)
Loop
What I would do is break it up by spaces and then check each word, if it starts with # uppercase it. Then put it all back together:
Function FixString(item As String) As String
Dim parts As String()
parts = item.Split(" ")
For index = 0 To parts.Length - 1
If (parts(index).StartsWith("#")) Then
parts(index) = parts(index).ToUpper()
End If
Next
Return String.Join(" ", parts)
End Function
So I am modeling my question with a simple Grocery List applications.
Program GUI:
Now what I want is for the Customer to enter: Eggs, Milk, and Bread and for that to enter and output to a .txt file.
Current Code:
Private Sub CreateList_Click()
Dim myFile As String, myString As String
myFile = "C:\Reformatted.txt"
Open myFile For Output As #1
myString = First.Value + Second.Value + Third.Value + Fourth.Value + Fifth.Value
Print #1, myString
Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub
Desired Operation:
What I want to happen is that ther enter there first 5 items. Then it prompts them if they want another 5. If they do then they can add another line.
So I understand that I can add a MsgBox in VB and just design a while loop for that. My question is how to display the results of their first/previous submissions?
Desired Result:
I understand that VB stores the values as variables, but how can I show them to the user while they still have a chance to enter more entries. Also how to add all this with the preferred formatting to a notepad file?
----------------------------After Miss Palmer's Answer--------------------------
Private Sub AddEntry_Click()
Dim UserEntry As String
UserEntry = First.Value + DDPP.Value + Filer.Value + EntryNumber.Value
myString = myString & Chr(13) & UserEntry
GroceryList.UserDisplay.Caption = "You have entered:" & myString
End Sub
Scenario 1 - First Addition
Scenario 2 - Second Addition
The two additions should be placed one after the other. But currently it just replaces it.
You can update a label on the form on each iteration of your while loop using something of the form:
FormName.LabelName.Caption = "you have entered:" & myString
and then add to the string each loop with
myString = myString & First.Value + Second.Value + Third.Value + Fourth.Value + Fifth.Value
EDIT
myString = myString & chr(13) & First.Value + Second.Value + Third.Value + Fourth.Value + Fifth.Value
The following code I'm about to posts works fine, however I need to be able to kick off multiple processes at the same time.
So to give some background, the listbox contains files that will be run through another process to create PDF files (essentially passing arguments to the other process which is the exe listed in the StartInfo.Filename). What's currently happening, say the listbox contains 10 files. Each file will be processed separately before the additional files are processed. I'd like to be able to kick off all 10 files at the same time instead of waiting. Some files may take longer than others, so I'm wasting time waiting for each file to finish.
Suggestions?
Dim UPSFiles = (From i In ListBoxUPSFiles.Items).ToArray()
For Each Item In UPSFiles
Dim UPSFiles2 = Item.ToString
Using psinfo As New Process
psinfo.StartInfo.FileName = "\\dgrvdp1\ClientServices\APPS\Printtrack\HeliosPNetExecuter\HeliosPNetExecuter.exe "
psinfo.StartInfo.Arguments = Arg2 + Arg3 + Arg4 + (Chr(34) + DATA_PATH + "\" + UPSFiles2 + Chr(34) + " ") + Arg6 + Arg7 + Arg8 + Arg9a + Arg10 + Arg11 + Arg13
psinfo.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
psinfo.Start()
'psinfo.WaitForExit()
End Using
Next
EDIT
Here's my current code, based on the Parallel.ForEach suggestion. It appears to sort of worked but submitted 10x the number of files I need to run. In my case, I have two files to process however like I mention the code produced 10x the number of processes I truly need.
Dim SequentialFiles = (From i In ListBoxSequentialFiles.Items).ToString
For Each Item In SequentialFiles
Dim SequentialFiles2 = Item.ToString
Parallel.ForEach(SequentialFiles2, Sub(processFiles)
Using psinfo As New Process
psinfo.StartInfo.FileName = "\\dgrvdp1\ClientServices\APPS\Printtrack\HeliosPNetExecuter\HeliosPNetExecuter.exe "
psinfo.StartInfo.Arguments = Arg2 + Arg3 + Arg4 + (Chr(34) + DATA_PATH + "\" + SequentialFiles2 + Chr(34) + " ") + Arg6 + Arg7 + Arg8 + Arg9c + Arg10 + Arg11 + Arg12
psinfo.StartInfo.WindowStyle = ProcessWindowStyle.Normal
psinfo.Start()
psinfo.WaitForExit()
End Using
End Sub)
Next
Depends how is PDF processor work. You can avoid creting threads, but simply launch 10 processes, by feeding inside one file per process. No need of multi threading, at this stage at least.
I have a macro that changes single quotes in front of a number to an apostrophe (or close single curly quote). Typically when you type something like "the '80s" in word, the apostrophe in front of the "8" faces the wrong way. The macro below works, but it is incredibly slow (like 10 seconds per page). In a regular language (even an interpreted one), this would be a fast procedure. Any insights why it takes so long in VBA on Word 2007? Or if someone has some find+replace skills that can do this without iterating, please let me know.
Sub FixNumericalReverseQuotes()
Dim char As Range
Debug.Print "starting " + CStr(Now)
With Selection
total = .Characters.Count
' Will be looking ahead one character, so we need at least 2 in the selection
If total < 2 Then
Return
End If
For x = 1 To total - 1
a_code = Asc(.Characters(x))
b_code = Asc(.Characters(x + 1))
' We want to convert a single quote in front of a number to an apostrophe
' Trying to use all numerical comparisons to speed this up
If (a_code = 145 Or a_code = 39) And b_code >= 48 And b_code <= 57 Then
.Characters(x) = Chr(146)
End If
Next x
End With
Debug.Print "ending " + CStr(Now)
End Sub
Beside two specified (Why...? and How to do without...?) there is an implied question – how to do proper iteration through Word object collection.
Answer is – to use obj.Next property rather than access by index.
That is, instead of:
For i = 1 to ActiveDocument.Characters.Count
'Do something with ActiveDocument.Characters(i), e.g.:
Debug.Pring ActiveDocument.Characters(i).Text
Next
one should use:
Dim ch as Range: Set ch = ActiveDocument.Characters(1)
Do
'Do something with ch, e.g.:
Debug.Print ch.Text
Set ch = ch.Next 'Note iterating
Loop Until ch is Nothing
Timing: 00:03:30 vs. 00:00:06, more than 3 minutes vs. 6 seconds.
Found on Google, link lost, sorry. Confirmed by personal exploration.
Modified version of #Comintern's "Array method":
Sub FixNumericalReverseQuotes()
Dim chars() As Byte
chars = StrConv(Selection.Text, vbFromUnicode)
Dim pos As Long
For pos = 0 To UBound(chars) - 1
If (chars(pos) = 145 Or chars(pos) = 39) _
And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then
' Make the change directly in the selection so track changes is sensible.
' I have to use 213 instead of 146 for reasons I don't understand--
' probably has to do with encoding on Mac, but anyway, this shows the change.
Selection.Characters(pos + 1) = Chr(213)
End If
Next pos
End Sub
Maybe this?
Sub FixNumQuotes()
Dim MyArr As Variant, MyString As String, X As Long, Z As Long
Debug.Print "starting " + CStr(Now)
For Z = 145 To 146
MyArr = Split(Selection.Text, Chr(Z))
For X = LBound(MyArr) To UBound(MyArr)
If IsNumeric(Left(MyArr(X), 1)) Then MyArr(X) = "'" & MyArr(X)
Next
MyString = Join(MyArr, Chr(Z))
Selection.Text = MyString
Next
Selection.Text = Replace(Replace(Selection.Text, Chr(146) & "'", "'"), Chr(145) & "'", "'")
Debug.Print "ending " + CStr(Now)
End Sub
I am not 100% sure on your criteria, I have made both an open and close single quote a ' but you can change that quite easily if you want.
It splits the string to an array on chr(145), checks the first char of each element for a numeric and prefixes it with a single quote if found.
Then it joins the array back to a string on chr(145) then repeats the whole things for chr(146). Finally it looks through the string for an occurence of a single quote AND either of those curled quotes next to each other (because that has to be something we just created) and replaces them with just the single quote we want. This leaves any occurence not next to a number intact.
This final replacement part is the bit you would change if you want something other than ' as the character.
I have been struggling with this for days now. My attempted solution was to use a regular expression on document.text. Then, using the matches in a document.range(start,end), replace the text. This preserves formatting.
The problem is that the start and end in the range do not match the index into text. I think I have found the discrepancy - hidden in the range are field codes (in my case they were hyperlinks). In addition, document.text has a bunch of BEL codes that are easy to strip out. If you loop through a range using the character method, append the characters to a string and print it you will see the field codes that don't show up if you use the .text method.
Amazingly you can get the field codes in document.text if you turn on "show field codes" in one of a number of ways. Unfortunately, that version is not exactly the same as what the range/characters shows - the document.text has just the field code, the range/characters has the field code and the field value. Therefore you can never get the character indices to match.
I have a working version where instead of using range(start,end), I do something like:
Set matchRange = doc.Range.Characters(myMatches(j).FirstIndex + 1)
matchRange.Collapse (wdCollapseStart)
Call matchRange.MoveEnd(WdUnits.wdCharacter, myMatches(j).Length)
matchRange.text = Replacement
As I say, this works but the first statement is dreadfully slow - it appears that Word is iterating through all of the characters to get to the correct point. In doing so, it doesn't seem to count the field codes, so we get to the correct point.
Bottom line, I have not been able to come up with a good way to match the indexing of the document.text string to an equivalent range(start,end) that is not a performance disaster.
Ideas welcome, and thanks.
This is a problem begging for regular expressions. Resolving the .Characters calls that many times is probably what is killing you in performance.
I'd do something like this:
Public Sub FixNumericalReverseQuotesFast()
Dim expression As RegExp
Set expression = New RegExp
Dim buffer As String
buffer = Selection.Range.Text
expression.Global = True
expression.MultiLine = True
expression.Pattern = "[" & Chr$(145) & Chr$(39) & "]\d"
Dim matches As MatchCollection
Set matches = expression.Execute(buffer)
Dim found As Match
For Each found In matches
buffer = Replace(buffer, found, Chr$(146) & Right$(found, 1))
Next
Selection.Range.Text = buffer
End Sub
NOTE: Requires a reference to Microsoft VBScript Regular Expressions 5.5 (or late binding).
EDIT:
The solution without using the Regular Expressions library is still avoiding working with Ranges. This can easily be converted to working with a byte array instead:
Sub FixNumericalReverseQuotes()
Dim chars() As Byte
chars = StrConv(Selection.Text, vbFromUnicode)
Dim pos As Long
For pos = 0 To UBound(chars) - 1
If (chars(pos) = 145 Or chars(pos) = 39) _
And (chars(pos + 1) >= 48 And chars(pos + 1) <= 57) Then
chars(pos) = 146
End If
Next pos
Selection.Text = StrConv(chars, vbUnicode)
End Sub
Benchmarks (100 iterations, 3 pages of text with 100 "hits" per page):
Regex method: 1.4375 seconds
Array method: 2.765625 seconds
OP method: (Ended task after 23 minutes)
About half as fast as the Regex, but still roughly 10ms per page.
EDIT 2: Apparently the methods above are not format safe, so method 3:
Sub FixNumericalReverseQuotesVThree()
Dim full_text As Range
Dim cached As Long
Set full_text = ActiveDocument.Range
full_text.Find.ClearFormatting
full_text.Find.MatchWildcards = True
cached = full_text.End
Do While full_text.Find.Execute("[" & Chr$(145) & Chr$(39) & "][0-9]")
full_text.End = full_text.Start + 2
full_text.Characters(1) = Chr$(96)
full_text.Start = full_text.Start + 1
full_text.End = cached
Loop
End Sub
Again, slower than both the above methods, but still runs reasonably fast (on the order of ms).