Update text file with Excel VBA

Question

I'm writing an Excel VBA program to take measurements of equipment and update values at various readings. Here is a brief sample of what my file looks like:

[11904]
400: 0.4
500: 0.3
600: 3.3

[11905]
400: 1.0
500: 2.0
600: 3.0

The number in the brackets is the S/N of the equipment being used, the big number is the measurement and the number after the colon is the equipment's offset value. What I want to do is write something that will locate the S/N, locate the measurement value, then overwrite the offset value. The .ini file has A LOT of S/Ns that all take the same measurement but have different offsets. Here is some demo code I've tried from Spreadsheet Guru:

Private Sub CommandButton1_Click()
'PURPOSE: Modify Contents of a text file using Find/Replace
'SOURCE: www.TheSpreadsheetGuru.com

Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String

'File Path of Text File
FilePath = "C:\Temp\test.ini"

'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile

'Open the text file in a Read State
Open FilePath For Input As TextFile

'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)

'Clost Text File
Close TextFile

'Find/Replace
FileContent = Replace(FileContent, "[HEADER TEST]", "[HEADER TEST]")
FileContent = Replace(FileContent, "Inserting new line", "Replacing line")
FileContent = Replace(FileContent, "Blah blah blah", "replaced this line too!")

'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile

'Open the text file in a Write State
Open FilePath For Output As TextFile

'Write New Text data to file
Print #TextFile, FileContent

'Clost Text File
Close TextFile
End Sub

The code works, but it updates anything that says "Inserting new line" and "blah blah blah." I was hoping it would only replace one occurrence once I had it find the "[HEADER TEST]."

My issue is two-fold:

How do I only change, say, measurement "400" for just one S/N in the file?

Also, once I locate text I want to change, how do I only write the offset value instead of the entire string?

If I'm able to successfully locate a line and only edit one line, I can just replace the entire string if need be. I cannot change the .ini's format, as we use a program that reads it.

Answer 1

You might consider using Filter, Split, and Join to isolate the area you want to change. Here's an example

Sub ReplaceOffset(ByVal sHead As String, ByVal sMeasure As String, ByVal dValue As Double)

    Dim sFile As String, lFile As Long
    Dim vaLines As Variant
    Dim vaMeasures As Variant
    Dim sOld As String, sNew As String, sOldMeas
    Dim i As Long

    lFile = FreeFile
    sFile = "C:\Temp\Test.ini"

    'Read in the file to an array
    Open sFile For Input As lFile
        vaLines = Split(Input$(LOF(lFile), lFile), "[")
    Close lFile

    'Filter to find the right header
    sOld = Filter(vaLines, sHead & "]")(0)
    'Split the header into measurements
    vaMeasures = Split(sOld, vbNewLine)

    'Get the old value
    sOldMeas = Filter(vaMeasures, sMeasure & ":")(0)
    'Replace old With new
    sNew = Replace(sOld, sOldMeas, sMeasure & ": " & Format(dValue, "0.0"))

    'Replace the old With the new and write it out to the file
    lFile = FreeFile
    Open sFile For Output As lFile
        Print #lFile, Replace(Join(vaLines, "["), sOld, sNew)
    Close lFile

End Sub

You call it like

ReplaceOffset "11906","500",.1

It splits the original file on [ so that each header is it's own line. Then it filters that array on whatever header you send in but adds a ] to the end of it so there's no false matches.

Once it finds the right header, it splits that on vbNewLine so that each measure is its own array element. The it filters that array to find the right measure. The old measure it replaced with the new measure. Then the old header is replaced with the new header.

If you pass in stuff that's not in the file, you'll get an error. So you should build some error checking into it.

Update: Descending Measures

The above code assumes the Measures appear ascending in the file. If they are descending, you can use

    sOldMeas = Filter(vaMeasures, sMeasure & ":")(UBound(Filter(vaMeasures, sMeasure & ":")))

The Filter() function returns an array of a wildcard match of the array. If you search for 700, the returned array will contain 2700, 1700, and 700 (assuming they are all present). The Filter(...)(0) syntax returns the first element - that works for ascending. The Filter(...)(Ubound(Filter(...))) returns the last element - works if they're sorted descending.

Update: Unsorted Measures

This version introduces some special characters so that you make sure you're only replacing an exact match of the Measures string

Sub ReplaceOffset(ByVal sHead As String, ByVal sMeasure As String, ByVal dValue As Double)

    Dim sFile As String, lFile As Long
    Dim vaLines As Variant
    Dim vaMeasures As Variant
    Dim sOld As String, sNew As String, sOldMeas
    Dim i As Long

    lFile = FreeFile
    sFile = "C:\Temp\Test.ini"

    'Read in the file to an array
    Open sFile For Input As lFile
        vaLines = Split(Input$(LOF(lFile), lFile), "[")
    Close lFile

    'Filter to find the right header
    sOld = Filter(vaLines, sHead & "]")(0)
    sOld = Replace$(sOld, vbNewLine, vbNewLine & "~")

    'Get the old value if Measures are unsorted
    vaMeasures = Split(sOld, vbNewLine)
    sOldMeas = Filter(vaMeasures, "~" & sMeasure & ":")(0)

    'Replace old With new
    sNew = Replace(sOld, sOldMeas, sMeasure & ": " & Format(dValue, "0.0"))
    sNew = Replace(sNew, vbNewLine & "~", vbNewLine)
    sOld = Replace(sOld, vbNewLine & "~", vbNewLine)

    'Replace the old With the new and write it out to the file
    lFile = FreeFile
    Open sFile For Output As lFile
        Print #lFile, Replace(Join(vaLines, "["), sOld, sNew)
    Close lFile

End Sub

It turns 2700:, 1700:, 700: into ~2700:, ~1700:, ~700: so that when you search for ~700:, you don't get 2700 regardless of the sort order.

Answer 2

Another approche you could use Excel functionality (if you are already using Excel :) ),
Load -> Textfiles
Search -> values
Rewrite -> Textfile

But the Code would have to be optimized

Private Sub CommandButton1_Click()

    Dim NewValue As String
    Dim FilePath As String
    Dim Index As Integer
    Dim TextRow

    FilePath = "C:\Temp\test.ini"

    SearchValue = "[11905]"
    ChangeValue = "400"
    NewValue = "123"

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" + FilePath, Destination:=Range("$A$1"))
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = ":"
        .TextFileColumnDataTypes = Array(1, 1)
        .Refresh BackgroundQuery:=False
    End With

    ' search for key
    Cells.Find(What:=SearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

    ' search for value to change
    Cells.Find(What:=ChangeValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate

    ' change Value
    ActiveCell.FormulaR1C1 = NewValue

    ' select bottom row start
    Range("A1").Select
    Selection.End(xlToRight).Select
    Selection.End(xlDown).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
    ' select bottom row end

    ' select all rows
    Range(Range("A1"), Selection).Select

    ' write file
    Open FilePath For Output As #1

        'Write New Text data to file
        For Index = 1 To Selection.Rows.Count + 1
            TextRow = Selection.Cells(Index, 1).FormulaR1C1
            If InStr(1, TextRow, "[") = 0 And Not TextRow = "" Then
                TextRow = TextRow + ":" + Selection.Cells(Index, 2).FormulaR1C1
            End If
            Print #1, TextRow
        Next Index

    Close #1

End Sub

Answer 3

To replace only first occurrence you should use combination of StrPos, Left and Mid functions:

if strpos(FileContent, "blabla") > 0 then 
    contentBeforeMatch = Left(FileContent, strpos(FileContent, "blabla") -1)
    contentAfterMatch = Mid(FileContent,  strpos(FileContent, "blabla") + Len("blabla") - 1))
    FileContent = contentBeforeMatch & "New Value" & contentAfterMatch
end if