VBA for Editing Text File

ShuStar

New Member
Joined
Sep 9, 2015
Messages
21
Hi all,

Quite new to VBA but would be very grateful if someone could help me with the below.

I can't figure out the code I need in order to go into a text file, remove lines 10, 11,12, 13 & 14 in the text file.

I've seen threads with the find and replace in a text file but cant use these as it's not the same.

I want to completely remove a specific line in my text file. Any help would be greatly appreciated.

Code so far:

Dim fso As Object '//FileSystemObject
Dim ts(1) As Object '//TextStream
Dim s As String, t As String
Dim FileContents As String
Dim strFilePath As String

strFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".xml"


Const SEARCH_FOR1 As String = "Line10" & "Line11" & "Line12" & "Line13" & "Line14" of text file"
Const REPLACE_WITH1 As String = ""




s = strFilePath


If s <> "False" Then


Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFilePath) Then


t = fso.GetParentFolderName(s) & "" & Replace(fso.GetTempName(), ".tmp", ".xml")
Name s As t
Set ts(0) = fso_OpenTextFile(t, 1, False, -2)
FileContents = ts(0).ReadAll
ts(0).Close
Set ts(0) = Nothing


FileContents = Replace(FileContents, SEARCH_FOR1, REPLACE_WITH1)

Set ts(1) = fso_OpenTextFile(s, 2, True, -2)
ts(1).Write (FileContents)
ts(1).Close
Set ts(1) = Nothing
fso.DeleteFile (t)

End If
End If
 

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
This will achieve your goal; you just need to set the input and output files appropriately.

Code:
Public Sub RemoveLines()

Dim inFilePath As String
Dim outFilePath As String
Dim inFile As Integer
Dim outFile As Integer
Dim lineCount As Long
Dim fileLine As String

inFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".xml"
outFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".tmp.xml"
If Dir$(inFilePath) = "" Then Exit Sub

inFile = FreeFile
Open inFilePath For Input As #inFile
outFile = FreeFile
Open outFilePath For Output As #outFile
lineCount = 0
Do Until EOF(inFile)
    Line Input #inFile, fileLine
    lineCount = lineCount + 1
    If lineCount < 10 Or lineCount > 14 Then
        Print #outFile, fileLine
    End If
Loop

Close #inFile
Close #outFile

End Sub
WBD
 

ShuStar

New Member
Joined
Sep 9, 2015
Messages
21
Many thanks for this :), really appreciate it.

Is there a way for the outfile to overwrite the infile so that it just goes in, removes the lines and saves the file with the original filename?

ShuStar
 

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
Rich (BB code):
Public Sub RemoveLines()

Dim inFilePath As String
Dim outFilePath As String
Dim inFile As Integer
Dim outFile As Integer
Dim lineCount As Long
Dim fileLine As String

inFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".xml"
outFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".tmp.xml"
If Dir$(inFilePath) = "" Then Exit Sub

inFile = FreeFile
Open inFilePath For Input As #inFile
outFile = FreeFile
Open outFilePath For Output As #outFile
lineCount = 0
Do Until EOF(inFile)
    Line Input #inFile, fileLine
    lineCount = lineCount + 1
    If lineCount < 10 Or lineCount > 14 Then
        Print #outFile, fileLine
    End If
Loop

Close #inFile
Close #outFile

Kill inFilePath
Name outFilePath As inFilePath

End Sub
WBD
 

ShuStar

New Member
Joined
Sep 9, 2015
Messages
21
Hi, I've been hit with another issue and was wondering if you were able to help...

1) I'm calling the shell function to open my notepad file to make further edits however struggling to make it dynamic like my previous code..
Currently it is: Call Shell("notepad C:\Users\Shudarstaran.Neel\Desktop\DummyTest.xml", vbNormalFocus)

I would like it to be something like Call Shell ("notepad ActiveSheet.Range("KL3") & ActiveSheet.Range("KL4") & ".xml",vbNormal Focus)


2) Once it opens my specified file, I need it to find and replace apostrophes and other values. I am having issues due to wanting to remove double apostrophes and replace with single apostrophes and my find and replace code is causing issues due to the overuse of apostrophes

Once the target file is opened i wish to find and replace the following:
Replace "" with "
Replace "< with <
Replace >" with >
Replace =B with ="B"

Is there a way to overcome the above?

Thanks in advance
 

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
It would be easier to do those edits as part of the code:

Rich (BB code):
Public Sub RemoveLines()

Dim inFilePath As String
Dim outFilePath As String
Dim inFile As Integer
Dim outFile As Integer
Dim lineCount As Long
Dim fileLine As String

inFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".xml"
outFilePath = ActiveSheet.Range("C3") & ActiveSheet.Range("C4") & ".tmp.xml"
If Dir$(inFilePath) = "" Then Exit Sub

inFile = FreeFile
Open inFilePath For Input As #inFile
outFile = FreeFile
Open outFilePath For Output As #outFile
lineCount = 0
Do Until EOF(inFile)
    Line Input #inFile, fileLine
    lineCount = lineCount + 1
    If lineCount < 10 Or lineCount > 14 Then
        fileLine = Replace(fileLine, """""", """")
        fileLine = Replace(fileLine, """<", "<")
        fileLine = Replace(fileLine, ">""", ">")
        fileLine = Replace(fileLine, "=B", "=""B""")
        Print #outFile, fileLine
    End If
Loop

Close #inFile
Close #outFile

Kill inFilePath
Name outFilePath As inFilePath

End Sub
WBD
 

Forum statistics

Threads
1,082,259
Messages
5,364,103
Members
400,779
Latest member
lumers

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top