I have 100's of text files named correctly, but I need the name of the text file added into the first row (thus shifting the existing data down to the second row) with " on either side of the name.
The text files are over multiple folders, so I need to be able to open an explorer dialogue first to select multiple text files and add the new header row to every one.
Any help would be hugely appreciated as I cannot find the answer anywhere on google!
Tom
My attempt, but doesnt really work becaue 1. I have to set the directory, and 2. I need to have the filename with " either side, for example "Line1":
Sub ChangeRlnName()
'the final string to print in the text file
Dim strData As String
'each line in the original text file
Dim strLine As String
Dim time_date As String
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get File Name
Filename = FSO.GetFileName("C:\Users\eflsensurv\Desktop\Tom\1.txt")
'Get File Name no Extension
FileNameWOExt = Left(Filename, InStr(Filename, ".") - 1)
strData = ""
time_date = Format(Date, "yyyymmdd")
'open the original text file to read the lines
Open "C:\Users\eflsensurv\Desktop\Tom\1.txt" For Input As #1
'continue until the end of the file
While EOF(1) = False
'read the current line of text
Line Input #1, strLine
'add the current line to strData
strData = strData + strLine & vbCrLf
Wend
'add the new line
strData = FileNameWOExt + vbLf + strData
Close #1
'reopen the file for output
Open "C:\Users\eflsensurv\Desktop\Tom\1.txt" For Output As #1
Print #1, strData
Close #1
End Sub
Try something like this:
Sub Tester()
Dim colFiles As Collection, f
'get all txt files under specified folder
Set colFiles = GetMatches("C:\Temp\SO", "*.txt")
'loop files and add the filename as a header
For Each f In colFiles
AddFilenameHeader CStr(f)
Next f
End Sub
Sub AddFilenameHeader(fpath As String)
Dim base, content
With CreateObject("scripting.filesystemobject")
base = .GetBaseName(fpath) 'no extension
With .OpenTextFile(fpath, 1)
'get any existing content
If Not .AtEndOfStream Then content = .readall()
.Close
End With
DoEvents
'overwrite existing content with header and previous content
.OpenTextFile(fpath, 2, True).write """" & base & """" & vbCrLf & content
End With
End Sub
'Return a collection of file paths given a starting folder and a file pattern
' e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Collection
Dim fso, fldr, f, subFldr, fpath
Dim colFiles As New Collection
Dim colSub As New Collection
Set fso = CreateObject("scripting.filesystemobject")
colSub.Add startFolder
Do While colSub.Count > 0
Set fldr = fso.getfolder(colSub(1))
colSub.Remove 1
If subFolders Then
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path
Next subFldr
End If
fpath = fldr.Path
If Right(fpath, 1) <> "\" Then fpath = fpath & "\"
f = Dir(fpath & filePattern) 'Dir is faster...
Do While Len(f) > 0
colFiles.Add fpath & f
f = Dir()
Loop
Loop
Set GetMatches = colFiles
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.