VBA for Editing Text File

ShuStar

Board Regular
Joined
Sep 9, 2015
Messages
89
Office Version
  1. 2010
Platform
  1. Windows
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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,253
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top