VBA DeleteFromArray Function - arrays

Question

I want to open a txt-File, read the textlines into arrays, delete specific arrays and write all those textlines into another textfile.
It might be easier to understand if you read the code:
Sub:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Integer
Dim tlmold() As String
Do Until EOF(1) 'read into array
ReDim Preserve tlmold(i)
Line Input #1, tlmold(i)
i = i + 1
Loop
Close #1
DeleteFromArray tlmold, "M17" 'function code below
DeleteFromArray tlmold, "I_R828"
*DeleteFromArray tlmold, "I_R872"*
Dim tllength As Integer
tllength = UBound(tlmold)
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
newtext = Replace(newtext, "ÿþ", "") 'remove BOM
Set Fileout = fso.CreateTextFile("G:\Arbeit\gen molding\Molding2.spf", True, True) 'create new textfile
Fileout.Write newtext
Fileout.Close
Function:
Function DeleteFromArray(ByRef Arr As Variant, StringToBeDeleted As String)
Dim arrlength As Integer
Dim strtest As String
arrlength = UBound(Arr)
strtest = StringToBeDeleted
For i = 0 To arrlength
strtest = Arr(i)
If InStr(strtest, StringToBeDeleted) <> 0 Then
Arr(i) = ""
ReDim Preserve Arr(arrlength - 1)
Exit Function
End If
Next i
End Function
Textfile "MOLDING.SPF":
G01 Z=0.1
G01 X=24.371 Z=-0.886
G03 X=24.370 Z=-1.040 CR=15.075
G01 X=24.126 Z=-12.934
G02 X=24.121 Z=-13.232 CR=50.500
G01 X=I_R830 *Z=-I_R872* ;MOLDING END PT
G01 *Z=-I_R872*-1.200
G01 X=I_R828
M17
The problem is while deleting I_R872 from the textfile, my function does notReDim the array a second time.
Because I_R872 is two times in the textfile.
So the array tlmold(5), which shouldn't exist, is just empty.
I hope you understand my "code" and can help me with my problem.
Thanks in Advance

Answer 1

The easiest way to accomplish what you are trying to do is simply not to place the unwanted text into the array in the first place:
Open "G:\Arbeit\gen molding\Molding.spf" For Input As #1 'code from textfile below
Dim i As Long
Dim j As Long
Dim tlmold() As String
Dim lineIn as String
Dim wanted As Boolean
Dim unwantedText
unwantedText = Array("M17","I_R828","I_R872")
Do Until EOF(1) 'read into array
'Read an input line
Line Input #1, lineIn
'Now decide whether we want that record
wanted = True
For j = LBound(unwantedText) To UBound(unwantedText)
If InStr(lineIn, unwantedText(j)) > 0 Then
wanted = False
Exit For
End If
Next
'If we want this record, re-dimension the array and store the value
If wanted Then
ReDim Preserve tlmold(i)
tlmold(i) = lineIn
i = i + 1
End If
Loop
Close #1
Dim tllength As Integer
'...

Answer 2

An alternative way to bypass arrays and loops is to work with the entire text of the file
Option Explicit
Public Sub UpdateFile()
Const FPATH = "G:\Arbeit\gen molding\"
Const SRC_FILE = FPATH & "Molding.spf"
Const DST_FILE = FPATH & "Molding2.spf"
Dim fullFile As String
Open SRC_FILE For Binary As #1
fullFile = Space$(LOF(1)) 'Read entire file into variable fullFile
Get #1, , fullFile
Close #1
fullFile = Replace(fullFile, "M17", vbNullString)
fullFile = Replace(fullFile, "I_R828", vbNullString)
fullFile = Replace(fullFile, "ÿþ", vbNullString)
Open DST_FILE For Output As #1
Print #1, fullFile 'Write contents back to the new file
Close #1
End Sub

Answer 3

Using newtext = Join(tlmold,vbCrLf) is much faster than the loop below:
For i = tllength To 0 Step -1 'newtext is the text for the new txt-file
newtext = newtext & tlmold(i) & vbCrLf
Next i
You could also use the Scripting.FileSystemObject to read the file. I refactored your code using a StringBuilder instead of an array. StringBuilders are optimized for concatenating strings.
Sub CreateNewSPF()
Const SPF_FILENAME1 = "G:\Arbeit\gen molding\Molding.spf"
Const SPF_FILENAME2 = "G:\Arbeit\gen molding\Molding2.spf"
Const ForReading = 1
Const ForWriting = 2
Dim lineIn As String
Dim fso As Object, StringBuilder As Object, TextStream1 As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set StringBuilder = CreateObject("System.Text.StringBuilder")
Set TextStream1 = fso.OpenTextFile(SPF_FILENAME1, ForReading)
Do Until TextStream1.AtEndOfStream
lineIn = TextStream1.ReadLine
If isValidSPF(lineIn) Then StringBuilder.Append_3 lineIn & vbCrLf
Loop
TextStream1.Close
StringBuilder.Replace "ÿþ", ""
Set Fileout = fso.CreateTextFile(SPF_FILENAME2, True, True) 'create new textfile
Fileout.Write StringBuilder.ToString
Fileout.Close
End Sub
Function isValidSPF(lineIn As String) As Boolean
Dim v As Variant
For Each v In Array("M17", "I_R828", "I_R872")
If InStr(1, lineIn, v, vbTextCompare) > 0 Then Exit Function
Next
isValidSPF = True
End Function