Saving text file in program

[dtennis]

I need to change multiple file names in a directory that contains almost 3000 files. I know how to change the names but I want to save the file and keep looping to the next file. I am using excel in a macro to loop thru the directory. Excel 2000.

Thanks

 

[PHV]

What have you so far ?

 

[dtennis]

Hey,
here is what I have so far. I know how to save a workbook, but I just want to loop thru and change the file names. I don't have to use excel, it just seemed easier:

Sub DirLoop()
Dim MyFile As String, Sep As String
' Sets up the variable "MyFile" to be each file in the directory
' This example looks for all the files that have an .xls extension.
' This can be changed to whatever extension is needed. Also, this
' macro searches the current directory. This can be changed to any
' directory.
' Test for Windows or Macintosh platform. Make the directory request.
Sep = Application.PathSeparator
If Sep = "\" Then
' Windows platform search syntax.
MyFile = Dir(CurDir() & Sep & "*.*")
Else
' Macintosh platform search syntax.
MyFile = Dir("", MacID("XLS5"))
End If
' Starts the loop, which will continue until there are no more files
' found.
Do While MyFile <> ""
' Displays a message box with the name of the file. This can be
' changed to any procedure that would be needed to run on every
' file in the directory such as opening each file.
If Len(MyFile) = 14 Then
MsgBox CurDir() & Sep & MyFile
MyFile = Left(MyFile, 3) & "_" & Mid(MyFile, 4, 4) & "_" & "gle" & Right(MyFile, 4)
MyFile = Replace(Left(MyFile, 3), "RCP", "rubbermaid") & "_" & Mid(MyFile, 5, 4) & "_" & "gle" & Right(MyFile, 4)
MsgBox MyFile

MyFile = Dir()
End
ElseIf Len(MyFile) < 10 Then
MsgBox CurDir() & Sep & MyFile
MyFile = Dir()
Else
MsgBox Len(MyFile)
MsgBox CurDir() & Sep & MyFile
MyFile = Dir()
End If
Loop
End Sub

 

[PHV]

I would prefer the FileSystemObject approach instead the Dir function.
Something like this:

Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(CurDir)
For Each objFile In objFolder.Files
  If UCase(Right(objFile.Name),4) = ".XLS" Then
    MyFile = objFile.Name
' Insert your renaming logic here
    If objFile.Name <> MyFile Then
      objFile.Name <> MyFile ' Rename the file
    End If
  End If
Next

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[dtennis]

Thanks for your help PHV!!