Make a text file from file names

vb6
win 2000

I need to take files name and make a text file  .txt file with just the name and  MINUS the extensions...

Example:
In folder  
c:\PICS\1A002.JPG
c:\PICS\1P321.JPG
c:\PICS\1SQE0.JPG
c:\PICS\1SQDF.JPG
c:\PICS\1A003.JPG
c:\PICS\1A004.JPG
c:\PICS\1VRDR.JPG
ETC........ any file in this folder


The text file would be called:
Names.txt
and would look like
1A002
1P321
1SQE0
1SQDF
1A003
1A004
1VRDR



Thanks
fordraiders





LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

amethyst3739Commented:
Hi Fordraiders,

You might want to try this:

Private Function RetrieveFiles(s_directory As String, ByRef coll_return_list As Collection)
  Dim s_file_list_item As String
 
  Set coll_return_list = New Collection
 
  s_file_list_item = Dir$(s_directory, vbDirectory)
 
  While (Len(s_file_list_item))
    If GetAttr(s_directory & s_file_list_item) <> vbDirectory Then
      coll_return_list.Add StripFileName(s_file_list_item)
    End If
    s_file_list_item = Dir$
  Wend
End Function

Private Function StripFileName(s_file As String) As String
  Dim n_lastperiod As Integer
 
  n_last_period = InStrRev(s_file, ".")
  If n_last_period <> 0 Then
    StripFileName = Mid(s_file, 1, n_last_period - 1)
  Else
    StripFileName = s_file
  End If
End Function

'------------------------------------------------------------------------------
'And then the calling routine could be something like this:

Private Sub Command1_Click()
 Dim file_list As Collection
 
 RetrieveFiles "C:\", file_list
End Sub
0
ShauliCommented:
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
0
ShauliCommented:
Didn't read the question properly. Please ignore :)

S
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

ShauliCommented:
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

0
sgayatriCommented:
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
           

0
sgayatriCommented:
Kindly take the following as the proper code,
as I forgot to include getting file name without extension
in my previous post


Set fso = CreateObject("scripting.filesystemobject")

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
amethyst,
Where does it create and put the new file ?

Thanks
0
FordraidersAuthor Commented:
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 !

0
sgayatriCommented:
Thanks. That's for sure, because I tested it before posting.
What's stopping you to close the question then?!?!?!?!?!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.