I have a folder ("EDI") [editions] with .txt files inside (01,02,03,04) I have this functional code:
ListBox2.Items.AddRange(File.ReadAllLines(Application.StartupPath & "\Cat\EDI\", "01.txt"))
ListBox2.Items.AddRange(File.ReadAllLines(Application.StartupPath & "\Cat\EDI\", "02.txt"))
ListBox2.Items.AddRange(File.ReadAllLines(Application.StartupPath & "\Cat\EDI\", "03.txt"))
until 68. Each file contains a list songs. But if I try to reduce the code implementing at "For Loop", as:
For i = 1 To 70
ListBox2.Items.AddRange(File.ReadAllLines(Application.StartupPath & "\Cat\EDI\", (i) & ".txt"))
Next
I get an error at (i) & ".txt". Says: "String cannot be converted in coding"
How can i solve?. Some to take in care is the name of the text files are 01.txt,02.txt WITH 2 NUMBERS, also the "for-loop" automatically changes 01 into 1
or better... How can i load all the text lines of all existent text files at folder?
I already have the list of files if it needed, I use this code to get all txt file names into another ListBox:
Dim newroot As String
newroot = (Application.StartupPath & "\Cat\EDI\")
listbox1.items.AddRange(IO.Directory.GetFiles(newroot, "*.txt").
Select(Function(f) IO.Path.GetFileNameWithoutExtension(f)))
The following uses an Interpolated String denoted by the $ preceding the string. This will call .ToString for you on the integer in the { }
Private Sub FileNamesInLoop()
For i As Integer = 1 To 9
ListBox1.Items.Add($"0{i}.txt")
Next
For i2 As Integer = 10 To 68
ListBox1.Items.Add($"{i2}.txt")
Next
End Sub
You can use the Integer.ToString(format) overload and specify number format 00. Doing so will always add a leading zero for numbers < 10, i.e:
5.ToString("00") becomes 05
9.ToString("00") becomes 09
23.ToString("00") becomes 23
Here's how you'd do it:
For i = 1 To 68
ListBox2.Items.AddRange(File.ReadAllLines(Application.StartupPath & "\Cat\EDI\", i.ToString("00") & ".txt"))
Next
Though I highly suggest you switch to Path.Combine() rather than concatenating the paths yourself, as it will ensure everything's done properly:
For i = 1 To 68
ListBox2.Items.AddRange(File.ReadAllLines(Path.Combine(Application.StartupPath, "Cat", "EDI", i.ToString("00") & ".txt")))
Next
Related
I have MS Access form where the user pastes a string into a field {Vars}, and I want to reformat that string into a new field so that (a) it retains whole words, and (b) "fits" within 70 columns.
Specifically, the user will be cutting/pasting variable names from SPSS. So the string will go into the field as whole names---no spaces allowed---with line breaks between each variable. So the first bit of VBA code looks like this:
Vars = Replace(Vars, vbCrLf, " ")
which removes the line breaks. But from there, I'm stumped---ultimately I want the long string that is pasted in the Vars field to be put on consecutive multiple lines that each are no longer than 70 columns.
Any help is appreciated!
Okay, for posterity, here is a solution:
The field name on the form that captures the user input is VarList. The call to the SPSS_Syntax function below returns the list of variable names (in "Vars") that can then be used elsewhere:
Vars = SPSS_Syntax(me.VarList)
Recall that user input into Varlist comes in as each variable (word) with a line break in between each. The problem is that we want the list to be on one line (horizontal, not vertical) AND a line can be no more than 256 characters in length (I'm setting it to 70 characters below). Here's the function:
Public Function SPSS_Syntax(InputString As String)
InputString = Replace(InputString, vbNewLine, " ") 'Puts the string into one line, separated by a space.
MyLength = Len(InputString) 'Computes length of the string
If MyLength < 70 Then 'if the string is already short enough, just returns it as is.
SPSS_Syntax = InputString
Exit Function
End If
MyArray = Split(InputString, " ") 'Creates the array
Dim i As Long
For i = LBound(MyArray) To UBound(MyArray) 'for each element in the array
MyString = MyString & " " & MyArray(i) 'combines the string with a blank space in between
If Len(MyString) > 70 Then 'when the string gets to be more than 70 characters
Syntax = Syntax & " " & vbNewLine & MyString 'saves the string as a new line
MyString = "" 'erases string value for next iteration
End If
Next
SPSS_Syntax = Syntax
End Function
There's probably a better way to do it but this works. Cheers.
I have written a code that produces a receipt to a text file. At the moment the receipt is unformatted. It looks like this:
Order Form
GTIN NAME QUANTITY
11111115 , plain bracket , 12
22222220 , wheelbarrow , 238
I want to have the code in a neat format that looks similar to this:
Order Form
GTIN NAME QUANTITY
11111115 plain bracket 12
22222220 wheelbarrow 238
Is there a function in visual basic that will allow me to format how I write the text to the file? I have used StringBuilder to append the text (which is from a ListBox - resulting in it being in it's current format) to the text file, although I do not know if using StringBuilder over StreamWriter will make a difference in how I can format it.
Code I'm currently using:
Dim CreateReceipt As New System.Text.StringBuilder()
CreateReceipt.Append("Order Form")
CreateReceipt.Append(Environment.NewLine + Environment.NewLine)
CreateReceipt.Append("GTIN" + " " + "NAME" + " " + "QUANTITY")
CreateReceipt.Append(Environment.NewLine)
For Each o As Object In lstOrderForm.Items
CreateReceipt.AppendLine(o)
Next
System.IO.File.WriteAllText("order_receipt.txt", CreateReceipt.ToString())
Process.Start("order_receipt.txt")
Try to use .PadRight. It will fill your string with blanks.
Example:
Dim x AS Integer = 0
Dim foo As String = x.ToString().PadRight(15)
'foo = "0 "
This is assuming your ListView looks something like this:
My setup is 3 Columns and 3 Items. Each Item has 2 SubItems. This may differ to yours but should give you some idea.
I'm going to use the String.PadRight method to evenly distribute the columns and text. I'm using 15 to pad however you really need to determine the longest string to ensure you pad correctly and evenly.
Dim sb As New StringBuilder
sb.AppendLine("Order Form" & vbCrLf)
sb.AppendLine("GTIN".PadRight(15) & "NAME".PadRight(15) & "QUANTITY".PadRight(15))
For Each lvi As ListViewItem In ListView1.Items
sb.AppendLine(lvi.SubItems(0).Text.PadRight(15) & lvi.SubItems(1).Text.PadRight(15) & lvi.SubItems(2).Text.PadRight(15))
Next
System.IO.File.WriteAllText("order_receipt.txt", sb.ToString())
Process.Start("order_receipt.txt")
This is a screenshot of the output:
This is an example of the padding going wrong. Here I have used 10 to pad with:
I am writing VBA code for an Excel workbook. I would like to be able to open a connection with an Access database, and then import a txt file (pipe delimited) and create a new table in the database from this txt file. I have searched everywhere but to no avail. I have only been able to find VBA code that will accomplish this from within Access itself, rather than from Excel. Please help! Thank you
Google "Open access database from excel VBA" and you'll find lots of resources. Here's the general idea though:
Dim db As Access.Application
Public Sub OpenDB()
Set db = New Access.Application
db.OpenCurrentDatabase "C:\My Documents\db2.mdb"
db.Application.Visible = True
End Sub
You can also use a data access technology like ODBC or ADODB. I'd look into those if you're planning more extensive functionality. Good luck!
I had to do this exact same problem. You have a large problem presented in a small question here, but here is my solution to the hardest hurdle. You first parse each line of the text file into an array:
Function ParseLineEntry(LineEntry As String) As Variant
'Take a text file string and parse it into individual elements in an array.
Dim NumFields As Integer, LastFieldStart As Integer
Dim LineFieldArray() As Variant
Dim i As Long, j As Long
'Determine how many delimitations there are. My data always had the format
'data1|data2|data3|...|dataN|, so there was always at least one field.
NumFields = 0
For I = 1 To Len(LineEntry)
If Mid(LineEntry, i, 1) = "|" Then NumFields = NumFields + 1
Next i
ReDim LineFieldArray(1 To NumFields)
'Parse out each element from the string and assign it into the appropriate array value
LastFieldStart = 1
For i = 1 to NumFields
For j = LastFieldStart To Len(LineEntry)
If Mid(LineEntry, j , 1) = "|" Then
LineFieldArray(i) = Mid(LineEntry, LastFieldStart, j - LastFieldStart)
LastFieldStart = j + 1
Exit For
End If
Next j
Next i
ParseLineEntry = LineFieldArray
End Function
You then use another routine to add the connection in (I am using ADODB). My format for entries was TableName|Field1Value|Field2Value|...|FieldNValue|:
Dim InsertDataCommand as String
'LineArray = array populated by ParseLineEntry
InsertDataCommand = "INSERT INTO " & LineArray(1) & " VALUES ("
For i = 2 To UBound(LineArray)
If i = UBound(LineArray) Then
InsertDataCommand = InsertDataCommand & "'" & LineArray(i) & "'" & ")"
Else
InsertDataCommand = InsertDataCommand & LineArray(i) & ", "
End If
Next i
Just keep in mind that you will have to build some case handling into this. For example, if you have an empty value (e.g. Val1|Val2||Val4) and it is a string, you can enter "" which will already be in the ParseLineEntry array. However, if you are entering this into a number column it will fail on you, you have to insert "Null" instead inside the string. Also, if you are adding any strings with an apostrophe, you will have to change it to a ''. In sum, I had to go through my lines character by character to find these issues, but the concept is demonstrated.
I built the table programmatically too using the same parsing function, but of this .csv format: TableName|Field1Name|Field1Type|Field1Size|...|.
Again, this is a big problem you are tackling, but I hope this answer helps you with the less straight forward parts.
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).
I have a textbox that reads like so:
Line 1
Line 2
Line 3
**Line 4**
Line 1
Line 2
Line 3
**Line 4**
(repeats...)
How can I use VB to loop through the textbox, deleting Lines 1, 2, and 3, skipping the fourth, and repeat? Or, rather, record every fourth line into a new textarea?
I'd probably get the contents, split on the newline character to create an array of strings (one string per line), then loop through the array outputting only the ones i wanted.
If this is VB6 then bear in mind that the variable length String type is a reference type meaning that operations will involve taking a deep copy i.e. concatenation is expensive.
Dim lines() As String
lines = VBA.Split(TextBox1.Text, vbCrLf)
Dim counter As Long
For counter = 3 To UBound(lines) Step 4
lines(counter) = Chr$(22)
Next
TextBox1.Text = _
Replace$( _
Replace$( _
VBA.Join(lines, vbCrLf), _
vbCrLf & Chr$(22), vbNullString), _
Chr$(22) & vbCrLf, vbNullString, 1)
This is code for the previous answer.
Private Function EveryFourthLine(ByVal input As String) As String
Dim newtxt As String = ""
Dim oldtxt As String() = input.Split(vbCrLf)
For i As Integer = 1 To oldtxt.Count
If i Mod 4 = 0 Then
newtxt = newtxt & oldtxt(i - 1)
If i <> oldtxt.Count Then
'add a vbcrlf to all but the last line
newtxt = newtxt & vbCrLf
End If
End If
Next
Return newtxt
End Function
If this is VB.Net and you are using a Textbox - you don't need to split anything yourself. You can just access the .Lines property. You'll get back an array of strings
You certainly can loop through the rows, like others have shown; but another approach is to use LINQ to do that work for you.
txtBox1.Lines = (From curLine In txtBox1.Lines _
Where Array.IndexOf(txtBox1.Lines, curLine) Mod 4 = 3).ToArray
What you are saying here is that you want the Lines in the textbox to be equal to all of the lines that are already in the text box - as long as the index of that particular line, divided by 4 has a remainder of three.
That sounds complicated when you type it out like that, but really, all it's going to do is give you every fourth line, and set that back into the textbox.