Basically, I am writting a small AutoCAD VBA that reads CSV files to run commands.
First, I put the csv into a string array (as it contains characters as well). One array position I need to use as a double for the command (as it requires it).
I though this would be a simple VAL() since it is supposed to keep the period regardlesss of my region.
Any insight is greatly appreciated.
Private Sub CommandButton2_Click()
sfilename = "C:\Users\Patrick.Legault\OneDrive - Cima+\Projects\AutoCAD Styles\" & ComboBox1.Value & ".csv"
Dim sLineFromFile As String
Dim name As String
Dim font As String
Dim height As String
Dim vlineItems() As String
Open sfilename For Input As #1
Do Until EOF(1)
Line Input #1, sLineFromFile
vlineItems = Split(sLineFromFile, ",")
Call add_textstyle(vlineItems)
Loop
Close #1
End Sub
Sub add_textstyle(vlineItems() As String)
'''Patrick Legault 2021-11-15
'''This routine creates new textstyles with height
Dim textStyle As AcadTextStyle
Dim TextColl As AcadTextStyles
Dim newfontstyle As String
Dim fontpath As String
Dim h_long As Double
fontpath = "C:\Users\Patrick.Legault\OneDrive - Cima+\Projects\AutoCAD Styles\Fonts" '''to be changed
Set TextColl = ThisDrawing.TextStyles '''get the textstyles from this drawing
Set textStyle = TextColl.add(vlineItems(1)) '''add new textstyle
textStyle.fontFile = fontpath & "\" & (vlineItems(2)) '''add new font style to textstyle
h_long = CDbl(Val(vlineItems(3))) ''this returns the value with comma
textStyle.height = (h_long)
MsgBox h_long
End Sub
The csv in question is below:
Text,STD,Romans.shx,2.032,Main Text heght and style
Text,MD,Romans.shx,3.048,
Text,LG,Romans.shx,4.064,
Text,BOM TEXT,Romans.shx,1.5875,Text for Bill of Material
Text,BOLD,Bold.shx,5.08,"Custom FortisBC ""SHX file (Bold)"
Text,BOLDFILL,Boldfill.shx,5.08,"Custom FortisBC ""SHX"" file (Boldfill)"
Text,DIM,Romans.shx,0,"Dim used in Dimension Style ""Engineering"""
Text,NAMEPLATE,Romans.shx,6.35,"Use ""bigfont.shx"""
Related
This is a follow on question to Select block of text and merge into new document
I have a SGM document with comments added and comments in my sgm file. I need to extract the strings in between the start/stop comments so I can put them in a temporary file for modification. Right now it's selecting everything including the start/stop comments and data outside of the start/stop comments.
Dim DirFolder As String = txtDirectory.Text
Dim Directory As New IO.DirectoryInfo(DirFolder)
Dim allFiles As IO.FileInfo() = Directory.GetFiles("*.sgm")
Dim singleFile As IO.FileInfo
Dim Prefix As String
Dim newMasterFilePath As String
Dim masterFileName As String
Dim newMasterFileName As String
Dim startMark As String = "<!--#start#-->"
Dim stopMark As String = "<!--#stop#-->"
searchDir = txtDirectory.Text
Prefix = txtBxUnique.Text
For Each singleFile In allFiles
If File.Exists(singleFile.FullName) Then
Dim fileName = singleFile.FullName
Debug.Print("file name : " & fileName)
' A backup first
Dim backup As String = fileName & ".bak"
File.Copy(fileName, backup, True)
' Load lines from the source file in memory
Dim lines() As String = File.ReadAllLines(backup)
' Now re-create the source file and start writing lines inside a block
' Evaluate all the lines in the file.
' Set insideBlock to false
Dim insideBlock As Boolean = False
Using sw As StreamWriter = File.CreateText(backup)
For Each line As String In lines
If line = startMark Then
' start writing at the line below
insideBlock = True
' Evaluate if the next line is <!Stop>
ElseIf line = stopMark Then
' Stop writing
insideBlock = False
ElseIf insideBlock = True Then
' Write the current line in the block
sw.WriteLine(line)
End If
Next
End Using
End If
Next
This is the example text to test on.
<chapter id="Chapter_Overview"> <?Pub Lcl _divid="500" _parentid="0">
<title>Learning how to gather data</title>
<!--#start#-->
<section>
<title>ALTERNATE MISSION EQUIPMENT</title>
<para0 verdate="18 Jan 2019" verstatus="ver">
<title>
<applicabil applicref="xxx">
</applicabil>Three-Button Trackball Mouse</title>
<para>This is the example to grab all text between start and stop comments.
</para></para0>
</section>
<!--#stop#-->
Things to note: the start and stop comments ALWAYS fall on a new line, a document can have multiple start/stop sections
I thought maybe using a regex on this
(<section>[\w+\w]+.*?<\/section>)\R(<\?Pub _gtinsert.*>\R<pgbrk pgnum.*?>\R<\?Pub /_gtinsert>)*
Or maybe use IndexOf and LastIndexOf, but I couldn't get that working.
You can read the entire file and split it into an array using the string array of {"<!--#start#-->", "<!--#stop#-->"} to split, into this
Element 0: Text before "<!--#start#-->"
Element 1: Text between "<!--#start#-->" and "<!--#stop#-->"
Element 2: Text after "<!--#stop#-->"
and take element 1. Then write it to your backup.
Dim text = File.ReadAllText(backup).Split({startMark, stopMark}, StringSplitOptions.RemoveEmptyEntries)(1)
Using sw As StreamWriter = File.CreateText(backup)
sw.Write(text)
End Using
Edit to address comment
I did make the original code a little compact. It can be expanded out into the following, which allows you to add some validation
Dim text = File.ReadAllText(backup)
Dim split = text.Split({startMark, stopMark}, StringSplitOptions.RemoveEmptyEntries)
If split.Count() <> 3 Then Throw New Exception("File didn't contain one or more delimiters.")
text = split(1)
Using sw As StreamWriter = File.CreateText(backup)
sw.Write(text)
End Using
I have VBA code to capture filenames to a table in an MS Access Database.
The values look like this:
FileName
----------------------------------------------------
WC1603992365_Michael_Cert_03-19-2019_858680723.csv
WC1603992365_John_Non-Cert_03-19-2019_858680722.csv
WC1703611403_Paul_Cert_03-27-2019_858679288.csv
Each filename has 4 _ underscores and the length of the filename varies.
I want to capture the value between the 2nd and the 3rd underscore, e.g.:
Cert
Non-Cert
Cert
I have another file downloading program, and it has "renaming" feature with a regular expression. And I set up the following:
Source file Name: (.*)\_(.*)\_(.*)\_(.*)\_\-(.*)\.(.*)
New File Name: \5.\6
In this example, I move the 5th section of the file name to the front, and add the file extension.
For example, WC1603992365_Michael_Cert_03-19-2019_858680723.csv would be saved as 858680723.csv in the folder.
Is there a way that I can use RegEx to capture 3rd section of the file name, and save the value in a field?
I tried VBA code, and searched SQL examples, but I did not find any.
Because the file name length is not fixed, I cannot use LEFT or RIGHT...
Thank you in advance.
One possible solution is to use the VBA Split function to split the string into an array of strings using the underscore as a delimiter, and then return the item at index 2 in this array.
For example, you could define a VBA function such as the following, residing in a public module:
Function StringElement(strStr, intIdx As Integer) As String
Dim strArr() As String
strArr = Split(Nz(strStr, ""), "_")
If intIdx <= UBound(strArr) Then StringElement = strArr(intIdx)
End Function
Here, I've defined the argument strStr as a Variant so that you may pass it Null values without error.
If supplied with a Null value or if the supplied index exceeds the bounds of the array returned by splitting the string using an underscore, the function will return an empty string.
You can then call the above function from a SQL statement:
select StringElement(t.Filename, 2) from Filenames t
Here I have assumed that your table is called Filenames - change this to suit.
This is the working code that I completed. Thank you for sharing your answers.
Public Function getSourceFiles()
Dim rs As Recordset
Dim strFile As String
Dim strPath As String
Dim newFileName As String
Dim FirstFileName As String
Dim newPathFileName As String
Dim RecSeq1 As Integer
Dim RecSeq2 As Integer
Dim FileName2 As String
Dim WrdArrat() As String
RecSeq1 = 0
Set rs = CurrentDb.OpenRecordset("tcsvFileNames", dbOpenDynaset) 'open a recordset
strPath = "c:\in\RegEx\"
strFile = Dir(strPath, vbNormal)
Do 'Loop through the balance of files
RecSeq1 = RecSeq1 + 1
If strFile = "" Then 'If no file, exit function
GoTo ExitHere
End If
FirstFileName = strPath & strFile
newFileName = strFile
newPathFileName = strPath & newFileName
FileName2 = strFile
Dim SubStrings() As String
SubStrings = Split(FileName2, "_")
Debug.Print SubStrings(2)
rs.AddNew
rs!FileName = strFile
rs!FileName68 = newFileName 'assign new files name max 68 characters
rs!Decision = SubStrings(2) 'extract the value after the 3rd underscore, and add it to Decision Field
rs.Update
Name FirstFileName As newPathFileName
strFile = Dir()
Loop
ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function
I have an application that reads a 5gb text file line by line and converts double quoted strings that are comma delimited to pipe delimited format.
i.e. "Smith, John","Snow, John" --> Smith, John|Snow, John
I have provided my code below. My question is: Is there a more efficient way of processing large files?
Dim fName As String = "C:\LargeFile.csv"
Dim wrtFile As String = "C:\ProcessedFile.txt"
Dim strRead As New System.IO.StreamReader(fName)
Dim strWrite As New System.IO.StreamWriter(wrtFile)
Dim line As String = ""
Do While strRead.Peek <> -1
line = strRead.ReadLine
Dim pattern As String = "(,)(?=(?:[^""]|""[^""]*"")*$)"
Dim replacement As String = "|"
Dim regEx As New Regex(pattern)
Dim newLine As String = regEx.Replace(line, replacement)
newLine = newLine.Replace(Chr(34), "")
strWrite.WriteLine(newLine)
Loop
strWrite.Close()
UPDATED CODE
Dim fName As String = "C:\LargeFile.csv"
Dim wrtFile As String = "C:\ProcessedFile.txt"
Dim strRead As New System.IO.StreamReader(fName)
Dim strWrite As New System.IO.StreamWriter(wrtFile)
Dim line As String = ""
Do While strRead.Peek <> -1
line = strRead.ReadLine
line = line.Replace(Chr(34) + Chr(44) + Chr(34), "|")
line = line.Replace(Chr(34), "")
strWrite.WriteLine(line)
Loop
strWrite.Close()
I tested your code and attempted to make a speed improvement by accumulating output lines into a StringBuilder. I also moved the regex declaration outside the loop.
When that did not work, I examined the CPU usage and disk I/O with Windows Process Monitor and it turned out that the bottleneck is the CPU (even when using an HDD instead of an SSD).
That led me to try an alternative method for modifying the text: if all you need to do is replace "," with | and remove any remaining double-quotes, then
newLine = line.Replace(""",""", "|").Replace("""", "")
turns out to be much faster (roughly fourfold in my testing) than using a regex.
(Further improvement might be possible with multi-threading, as #Werdna suggested, as long as more than one processor is available and you can coordinate writing back the modified data in the correct order.)
So here's the relevant snippet of my code (COPSFolder is a constant defined elsewhere):
Sub CreateReport(ByRef InfoArray() As String)
Dim BlankReport As Workbook
Dim ReportSheet As Worksheet
Dim ProjFolder As String
ProjFolder = COPSFolder & "InProgress\" & InfoArray(3)
If Not Dir(ProjFolder, vbDirectory) = vbNullString Then
Debug.Print ProjFolder
MkDir ProjFolder <-----ERROR 76 HAPPENS HERE
End If
On the line indicated, ProjFolder & "InProgress\" is an existing directory. I'm trying to create a folder within it based on a value in an array of strings.
Here's what boggles me. If I replace "InfoArray(3)" with a string (ex. "12345") it works fine, but trying to use an element in the array will throw the error. The array is defined as a string everywhere it is referenced, and there are no type mismatches elsewhere in the Module.
edit: Public Const COPSFolder As String = "\\ktch163\COPS\"
edit2: here's another weird thing - if I replace InfoArray(3) with Str(InfoArray(3)) it seems towork. What I don't get is that the value of InfoArray(3) is already defined as a string. Also, it adds a space in front of the value. I can use Right(Str(InfoArray(3)), 5) I guess, but would like to figure out what the real issue is here.
edit3: as requested, here's how InfoArray() is populated:
Public Function GetPartInfo(ByRef TextFilePath As String) As String()
'Opens text file, returns array with each element being one line in the text file
'(Text file contents delimited by line break character)
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim Info As Variant
Dim txtstream As Object
Dim item as Variant
Debug.Print TextFilePath
Set txtstream = fso.OpenTextFile(TextFilePath, ForReading, False)
GetPartInfo = Split(txtstream.ReadAll, Chr(10))
For Each item In GetPartInfo
item = Trim(item)
Next
End Function
Later on in the code - InfoArray = GetPartInfo(File.Path). (File.Path works fine, no errors when running GetPartInfo
The problem is that you are splitting using Chr(10) This is not removing the spaces. And hence when you are calling ProjFolder = COPSFolder & "InProgress\" & InfoArray(3), you have spaces in InfoArray(3)
You have 3 options
When you are creating the array, remove the spaces there OR
When you are assigning InfoArray = GetPartInfo(File.Path), remove the spaces there OR
Change the line ProjFolder = COPSFolder & "InProgress\" & InfoArray(3) to ProjFolder = COPSFolder & "InProgress\" & Trim(InfoArray(3))
I use Excel VBA and the following method to search a string in html files, and replace it with the same string after adding bold tag.
FindAndReplace ("C:\xxx.htm", "hello world", "<b>hello world</b>")
Private Sub FindAndReplace(filePath As String, findWhat As String, replaceWith As String)
Dim nextFileNum As Long
Dim oldFileContents As String
Dim newFileContents As String
Dim textFileTypes() As String
Dim fileExtension As String
Dim sFileName As String
Dim iFileNum As Integer
Dim sBuf As String
Dim strFound As Integer
If Len(Dir(filePath)) = 0 Then
Exit Sub
End If
nextFileNum = FreeFile
Open filePath For Input As #nextFileNum
oldFileContents = Input$(LOF(nextFileNum), #nextFileNum)
Close #nextFileNum
newFileContents = Replace(oldFileContents, findWhat, replaceWith)
nextFileNum = FreeFile
Open filePath For Output As #nextFileNum
Print #nextFileNum, newFileContents
Close #nextFileNum
End Sub
The problem I am facing is the function won;t find the string if it splits in between because of the html source code line break.
For example, the string is found if the code is:
<p>hi hola hello world</p>
but it is not found if the code is:
<p>hi hola hello
world</p>
Is there any other VBA method that I can use to search and replace text, or some functionality can be added to the above code so that it ignores the line break in between.
Try using a variation of:
Function RemoveCarriageReturns(SourceString As String) As String
Dim s As String
'strip out CR and LF characters together
s = Replace(SourceString, vbCrLf, "")
'just in case, remove them one at a time
s = Replace(s, Chr(13), "")
s = Replace(s, Chr(10), "")
RemoveCarriageReturns = s
End Function
The ASCII characters 13 and 10 are the carriage return and line feed characters.
If the split is only with linefeeds/returns (Chr(10), Chr(13)) and/or spaces Chr(32) then you might just search for "hello" first.
When found look for those characters (10, 13 and 32) and skip over them until you run into something else (use a DO WHILE ... OR ... OR ... OR loop).
Now check if that something else would be "world" and at least 1 of these characters was encountered.
In that case you will change "hello" into "<b>hello" and "world" into "world</b>"