Dim fso, folderObject, filesObject, fileObject
Dim topFolderName
Dim fileCounter
topFolderName = InputBox("Enter path to CSV files to update including trailling \.")
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(topFolderName) Then
Set folderObject = fso.GetFolder(topFolderName)
Set filesCollection = folderObject.Files
For Each file In filesCollection
If UCASE(Right(file.Name,3)) = "CSV" Then
removeLines (topFolderName & file.Name)
fileCounter = fileCounter + 1
End If
Next
Else
MsgBox "Source folder not found.", vbExclamation, "Error"
End If
MsgBox fileCounter & " files processed.", vbOKOnly + vbInformation, "Complete"
Set fso = Nothing
Set folderObject = Nothing
Set filesCollection = Nothing
Private Function removeLines(ByVal sFileToOpen)
Dim fsoObject
Dim textFileReadObject
Dim textFileWriteObject
Dim lineCounter
Set fsoObject = CreateObject("Scripting.FileSystemObject")
Set textFileReadObject = fsoObject.OpenTextFile(sFileToOpen)
Set textFileWriteObject = fsoObject.CreateTextFile(sFileToOpen & "_", True)
lineCounter = 0
Do While Not textFileReadObject.AtEndOfStream
lineCounter = lineCounter + 1
sReadLine = textFileReadObject.ReadLine
Select Case lineCounter
Case 1, 2, 4
' The lines above will be skipped - modify them to get desiredresults
Case Else
textFileWriteObject.WriteLine (sReadLine)
End Select
Loop
Set fsoObject = Nothing
Set textfileObject = Nothing
Set textFileReadObject = Nothing
Set textFileWriteObject = Nothing
End Function