Make a text file from file names

Public Sub RenameFiles(ByVal fnFolder As String, fnSrcExtension As String, fnTrgExtension As String)
Dim srcFile As String, lenTrg As String
If Right(fnFolder, 1) <> "\" Then fnFolder = fnFolder & "\"
srcFile = Dir(fnFolder & "*." & fnSrcExtension, vbDirectory)
    Do While Not srcFile = vbNullString
        Select Case srcFile
            Case ".", ".."
            Case Else
                lenTrg = Right(srcFile, Len(srcFile) - InStrRev(srcFile, ".", -1))
                Name fnFolder & srcFile As fnFolder & Left(srcFile, Len(srcFile) - Len(lenTrg)) & fnTrgExtension
        End Select
        srcFile = Dir
    Loop
MsgBox "Mission accomplished"
End Sub

Private Sub Command1_Click()
Call RenameFiles("c:\PICS", "jpg", "txt")
End Sub

S

Didn't read the question properly. Please ignore :)

S

Set reference to "Microsoft Scripting runtime" (From the menu bar select Project > Reference > and scroll down to "Microsoft Scripting runtime" and check the box).


Public Sub RenameFiles(ByVal fnSrcFolder As String, fnTrgFolder As String, fnSrcExtension As String, fnTrgExtension As String)
Dim srcFile As String, lenTrg As String, FSO As FileSystemObject
Set FSO = New FileSystemObject
If Right(fnSrcFolder, 1) <> "\" Then fnSrcFolder = fnSrcFolder & "\"
If Right(fnTrgFolder, 1) <> "\" Then fnTrgFolder = fnTrgFolder & "\"
srcFile = Dir(fnSrcFolder & "*." & fnSrcExtension, vbDirectory)
    Do While Not srcFile = vbNullString
        Select Case srcFile
            Case ".", ".."
            Case Else
                FSO.CreateTextFile fnTrgFolder & Left(srcFile, InStrRev(srcFile, ".", -1)) & fnTrgExtension
        End Select
        srcFile = Dir
    Loop
MsgBox "Mission accomplished"
End Sub

Private Sub Command1_Click()
Call RenameFiles("c:\PICS", "c:\PICS", "jpg", "txt")
End Sub

'when you call the sub, the first parameter is the source folder, the second is the target folder, the third is the source extenstion, and the lat is the target extension

S

In the following code
1. Assign your complete path to drv
2. give your file for mainfile

Dim fso
Dim f, sf, f1

        Set fso = CreateObject("scripting.filesystemobject")

        Set mainfile = fso.CreateTextFile("c:\tempfile.txt")
        drv = "c:\"           ''specify your folder here
       
        Set f = fso.GetFolder(drv)
        Set sf = f.SubFolders
       
        For Each f1 In sf
        mainfile.WriteLine (f1.Name)
         mainfile.WriteBlankLines (1)
         
        Next
     
        mainfile.Close
    Set fso = Nothing
           

amethyst,
Where does it create and put the new file ?

Thanks

Shauli,
I'm not wanting to rename the files themselves.
Take the file names and creating ONE text file. Which will have all the filename but NO extensions.

Just like sgayatri did.
sgayatri ,
code worked great !