In a text file, I want to remove all Carriage Returns (vbCrLf) except those vbCrLf that are preceded by a period (.)
Honestly, no regex is needed.
Open the text file, split the entire text contents on what you want to retain (to create an array), then loop through the array and replace want you don't want during the file rewrite, ensuring to append what you wanted to retain.
For example:
Dim retain : retain = "." & vbCrLf
Dim toss : toss = vbCrLf
With CreateObject("Scripting.FileSystemObject")
Dim txtFile
With .OpenTextFile("C:\TestFile.txt", 1, False)
txtFile = Split(.ReadAll(), retain)
.Close
End With
With .OpenTextFile("C:\NewTestFile.txt", 2, True)
Dim row
For Each row In txtFile
.Write Replace(row, toss, " ") & retain
Next
.Close
End With
End With
Truth be told, VBScript's RegExp Pattern syntax may not be robust enough -- due to lack of look-ahead patterns -- to handle your conditional criteria cleanly with a single pass.
Related
I've been working on a VBScript that finds all files with a specific extension, .dat, searches for a specific pattern, "Date Due:\d{8}", and shifts the string around in a specific format.
I am having two problems with the below code:
It is not reading the first line. Whenever I run the script it seems to jump immediately to the second line.
It is only using the first pattern it finds and replaces the following patterns with the first pattern in the newly formatted manner.
I hope this makes sense, it's a very specific script, but I am hoping for some help understanding the problem here.
Below is my code:
Set fso = CreateObject("Scripting.FileSystemObject")
'newtext = vbLf & "Date Due:" & sub_month & sub_day & sub_year 'the text replacing Date Due:
'the purpose of this script is to format the date after Date Due:, which is currently formatted as YYYYMMDD, to MM/DD/YYYY
'example: Date Date:20180605 should be Date Due:06/05/2018
Set re = New RegExp
re.Pattern = "(\nDate Due:\d{8})" 'Looking for line, Date Due: followed by 8 digits
Dim sub_str 'substring of date due, returns the 8 digits aka the date 12345678
Dim sub_month
Dim sub_day
Dim sub_year
Dim concat_full
re.Global = False
re.IgnoreCase = True
For Each f In fso.GetFolder("C:\Users\tgl\Desktop\TestFolder\").Files
If LCase(fso.GetExtensionName(f.Name)) = "dat" Then
text = f.OpenAsTextStream.ReadAll
sub_str = Mid(text, 10, 8) 'substring of the full line, outputs the 8 digit date
sub_month = Mid(sub_str, 5, 2) 'substring of the date, outputs the 2 digit month
sub_day = Mid(sub_str, 7, 2) 'substring of the date, outputs the 2 digit day
sub_year = Mid(sub_str, 1, 4) 'substring of the date, outputs the four digit year
newtext = vbLf & "Date Due:" & sub_month & "/" & sub_day & "/" & sub_year 'replaces the text pattern defined above and concatenates the substrings with slashes
'concat_full = (sub_month & sub_day & sub_year)
f.OpenAsTextStream(2).Write re.Replace(text, newtext)
End If
Next
EDIT: When changing re.Global to True it replaces each line with the one found pattern. It should be using each found pattern as it's own and not the first one it finds.
Make your regular expression more specific and use capturing groups for extracting the relevant submatches:
re.Pattern = "(\nDate Due:)(\d{4})(\d{2})(\d{2})"
then replace the matches like this:
re.Replace(text, "$1$4/$3/$2")
$1 through $4 in the replacement string are backreferences to the capturing groups in the pattern (i.e. they're replaced with the respective captured substring).
I want to insert an if statement in a cell through vba which includes double quotes.
Here is my code:
Worksheets("Sheet1").Range("A1").Value = "=IF(Sheet1!B1=0,"",Sheet1!B1)"
Due to double quotes I am having issues with inserting the string. How do I handle double quotes?
I find the easiest way is to double up on the quotes to handle a quote.
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0,"""",Sheet1!A1)"
Some people like to use CHR(34)*:
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0," & CHR(34) & CHR(34) & ",Sheet1!A1)"
*Note: CHAR() is used as an Excel cell formula, e.g. writing "=CHAR(34)" in a cell, but for VBA code you use the CHR() function.
Another work-around is to construct a string with a temporary substitute character. Then you can use REPLACE to change each temp character to the double quote. I use tilde as the temporary substitute character.
Here is an example from a project I have been working on. This is a little utility routine to repair a very complicated formula if/when the cell gets stepped on accidentally. It is a difficult formula to enter into a cell, but this little utility fixes it instantly.
Sub RepairFormula()
Dim FormulaString As String
FormulaString = "=MID(CELL(~filename~,$A$1),FIND(~[~,CELL(~filename~,$A$1))+1,FIND(~]~, CELL(~filename~,$A$1))-FIND(~[~,CELL(~filename~,$A$1))-1)"
FormulaString = Replace(FormulaString, Chr(126), Chr(34)) 'this replaces every instance of the tilde with a double quote.
Range("WorkbookFileName").Formula = FormulaString
This is really just a simple programming trick, but it makes entering the formula in your VBA code pretty easy.
All double quotes inside double quotes which suround the string must be changed doubled. As example I had one of json file strings : "delivery": "Standard",
In Vba Editor I changed it into """delivery"": ""Standard""," and everythig works correctly. If you have to insert a lot of similar strings, my proposal first, insert them all between "" , then with VBA editor replace " inside into "". If you will do mistake, VBA editor shows this line in red and you will correct this error.
I have written a small routine which copies formula from a cell to clipboard which one can easily paste in Visual Basic Editor.
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
It is originally posted on Chandoo.org forums' Vault Section.
In case the comment by gicalle ever dies:
I prefer creating a global variable:
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Public Const vbSingleQuote As String = "'" 'represents 1 single quote (')
and using it like so:
Shell "explorer.exe " & vbDoubleQuote & sPath & vbDoubleQuote, vbNormalFocus
A VBScript is in use to shorten the system path by replacing entries with the 8.3 versions since it gets cluttered with how much software is installed on our builds. I'm currently adding the ability to remove duplicates, but it's not working correctly.
Here is the relevant portion of code:
original = "apple;orange;apple;lemon\banana;lemon\banana"
shortArray=Split(original, ";")
shortened = shortArray(1) & ";"
For n=2 to Ubound(shortArray)
'If the shortArray element is not in in the shortened string, add it
If NOT (InStr(1, shortened, shortArray(n), 1)) THEN
shortened = shortened & ";" & shortArray(n)
ELSE
'If it already exists in the string, ignore the element
shortened=shortened
End If
Next
(Normally "original" is the system path, I'm just using fruit names to test...)
The output should be something like
apple;orange;lemon\banana
The issue is entries with punctuation, such as lemon\banana, seem to be skipped(?). I've tested it with other punctuation marks, still skips over it. Which is an issue, seeing how the system path has punctuation in every entry.
I know the basic structure works, since there are only one of each entry without punctuation. However, the real output is something like
apple;orange;lemon\banana;lemon\banana
I thought maybe it was just a character escape issue. But no. It still will not do anything with entries containing punctuation.
Is there something I am doing wrong, or is this just a "feature" of VBScript?
Thanks in advance.
This code:
original = "apple;orange;apple;lemon\banana;lemon\banana"
shortArray = Split(original, ";")
shortened = shortArray(0) ' array indices start with 0; & ";" not here
For n=1 to Ubound(shortArray)
'If the shortArray element is not in in the shortened string, add it
'i.e. If InStr() returns *number* 0; Not applied to a number will negate bitwise
' If 0 = InStr(1, shortened, shortArray(n), 1) THEN
If Not CBool(InStr(1, shortened, shortArray(n), 1)) THEN ' if you insist on Not
WScript.Echo "A", shortArray(n), shortened, InStr(1, shortened, shortArray(n), vbTextCompare)
shortened = shortened & ";" & shortArray(n)
End If
Next
WScript.Echo 0, original
WScript.Echo 1, shortened
WScript.Echo 2, Join(unique(shortArray), ";")
Function unique(a)
Dim d : Set d = CreateObject("Scripting.Dictionary")
Dim e
For Each e In a
d(e) = Empty
Next
unique = d.Keys()
End Function
output:
0 apple;orange;apple;lemon\banana;lemon\banana
1 apple;orange;lemon\banana
2 apple;orange;lemon\banana
demonstrates/explains your errors (indices, Not) and shows how to use the proper tool for uniqueness (dictionary).
Hi I have a text file that I would like to assign to an array and then assign each item in the array to a custom defined variable. When I open the file in notepad, it seems as if the data is on one line and there's about 10 tabs worth of space until the next piece of information.
I use the following code to successfully view the information in a msgbox as MyArray(i).
In my code example, all the information is listed in MyArray(0) and MyArray(1) gives me an error of subscript out of range. The information in the text file seems to appear as if it were delimited by vbCrLf but that does not work either...
Is there a way to trim the spaces from MyArray(0) and then re-assign the individual data to a new array? Here's what the first two pieces of information look like from my file:
967042
144890
Public Function ReadTextFile()
Dim TextFileData As String, myArray() As String, i As Long
Dim strCustomVariable1 As String
Dim strCustomVariable2 As String
'~~> Open file as binary
Open "C:\textfile\DATA-SND" For Binary As #1
'~~> Read entire file's data in one go
TextFileData = Space$(LOF(1))
Get #1, , TextFileData
'~~> Close File
Close #1
'~~> Split the data in seperate lines
myArray() = Split(TextFileData, vbCrLf)
For i = 0 To UBound(myArray())
MsgBox myArray(i)
Next
End Function
Under normal circumstances, I'd suggest that you use Line Input instead:
Open "C:\textfile\DATA-SND" For Input As #1
Do Until EOF(1)
Redim Preserve myArray(i)
Line Input #1, myArray(i)
i = i + 1&
Loop
Close #1
However, you're likely dealing with different end-line characters. You can use your existing code and just change it to use vbCr or vbLf instead of vbCrLf. My method assumes that your end-line characters are vbCrLf.
So for UNIX files:
myArray() = Split(TextFileData, vbLf)
And for old Mac files:
myArray() = Split(TextFileData, vbCr)
I have a group of files that are named as such (word can be any word or numbers):
Word word-word word word Floor B2342 Word Word-word.pdf
Word word-word word Floor: B-2342 Word Word-word.pdf
Word word- Floor C43 Word Word.pdf
Word word word- Floor- E2AD342 Word Word.pdf
I want to rename everything in the folder to only have the group that follows Floor... You can count on Floor always being in the file name and what I want to keep following floor.
B2342.pdf
B-2342.pdf
C43.pdf
E2AD342.pdf
Pass the path of the folder you want to process as the first argument to this script. You might have to tweak the regular expression for your input.
Set expr = New RegExp
Set fs = CreateObject("Scripting.FileSystemObject")
Set fpath = fs.GetFolder(WScript.Arguments(0))
expr.Pattern = "Floor\S*\s+([^\s.]*)"
For Each fspec In fpath.Files
Set matches = expr.Execute(fspec.Name)
If matches.Count = 0 Then
WScript.StdErr.WriteLine "Invalid file name " & fspec.Name
Else
fspec.Move fspec.ParentFolder & "\" & matches(0).Submatches(0) & ".pdf"
End If
Next