Rename a batch of files

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Greg Maxey - 24 Mar 2005 04:27 GMT

Hi,

I am trying to combine some code that Jay Freedman and Doug Robbins have
posted with the object of renaming a batch of files. The renamed files
should be named with the first couple of words in the test.

The files are all located in C:\Text an named 1.doc, 2.doc, 3.doc etc.

Here is my code, followed by problems I can't resolve:

Option Explicit
Public Sub BatchReNameFiles()

Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim fn As String
Dim rg As Range

PathToUse = "C:\Test\"
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
Set myDoc = Documents.Open(PathToUse & myFile)
With ActiveDocument
Set rg = .Words(1)
rg.End = .Words(min(9, .Words.Count - 1)).End
fn = Trim(rg.Text) & ".doc"
fn = Replace(fn, "\", "")
fn = Replace(fn, ":", "")
fn = Replace(fn, """", "")
fn = Replace(fn, vbCr, "")
fn = Replace(fn, vbTab, "")
End With
With Dialogs(wdDialogFileSaveAs)
.Name = "C:\Documents\tests\" & fn
.Show
'Trying to use SendKeys to represent ALT+S and save the file. Isn't
working
SendKeys "%s"
End With
myDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub
Private Function min(a As Long, b As Long)
min = -((a < b) * a + (a >= b) * b)
End Function

Problems:

1) I can't get the SendKeys statement to duplicate ALT+s which completes
the save and closes the dialog box. I must manually click ALT+s or click
the save button to step through the macro. How do I get SendKeys to work?

2) For some reason the While statement repeats the first saved file. I mean
1.doc opens and is saved as say One Little Indian. Then 2.doc is saved as
Two Little Indians, then 3.doc as Three Little Indians. For some reason One
Little Indian.doc opens with the SaveAs One Little Indian dialog displayed.
Any ideas why?

3) The original 1.doc 2.doc and 3.doc files remain in the directory. Can
these be deleted as part of the VBA code?

Thanks All.

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Reply to this Message

Jean-Guy Marcil - 24 Mar 2005 06:04 GMT

Greg Maxey was telling us:
Greg Maxey nous racontait que :

> Hi,
>
[quoted text clipped - 50 lines]
> ALT+s or click the save button to step through the macro. How do I
> get SendKeys to work?

Avoid SendKeys if you can (It is borderline hacking and is not always
reliable...)
In this case, it is easy to avoid.
Try this instead:

'_______________________________________
Option Explicit
'_______________________________________
Public Sub BatchReNameFiles()

Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim NewName As String
Dim OldName As String
Dim rg As Range

PathToUse = "X:\Test\Batch\"

myFile = Dir$(PathToUse & "*.doc")

While myFile <> ""
Set myDoc = Documents.Open(FileName:=PathToUse & myFile, Visible:=False)
With myDoc
OldName = .FullName
Set rg = .Words(1)
rg.End = .Words(min(9, .Words.Count - 1)).End
NewName = Trim(rg.Text) & ".doc"
NewName = Replace(NewName, "\", "")
NewName = Replace(NewName, ":", "")
NewName = Replace(NewName, """", "")
NewName = Replace(NewName, vbCr, "")
NewName = Replace(NewName, vbTab, "")

.Close SaveChanges:=wdSaveChanges
End With

Name OldName As PathToUse & NewName

myFile = Dir$()
Wend

End Sub
'_______________________________________

'_______________________________________
Private Function min(a As Long, b As Long)
min = -((a < b) * a + (a >= b) * b)
End Function
'_______________________________________

No need to fuss around with the Save As dialog.
Why don't you use the SaveAs method instead?

'_______________________________________
Option Explicit
Public Sub BatchReNameFiles()

Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim NewName As String
Dim OldName As String
Dim rg As Range

PathToUse = "X:\Test\Batch\"

myFile = Dir$(PathToUse & "*.doc")

While myFile <> ""
Set myDoc = Documents.Open(FileName:=PathToUse & myFile, Visible:=False)
With myDoc
OldName = .FullName
Set rg = .Words(1)
rg.End = .Words(min(9, .Words.Count - 1)).End
NewName = Trim(rg.Text) & ".doc"
NewName = Replace(NewName, "\", "")
NewName = Replace(NewName, ":", "")
NewName = Replace(NewName, """", "")
NewName = Replace(NewName, vbCr, "")
NewName = Replace(NewName, vbTab, "")

.SaveAs PathToUse & NewName
.Close wdSaveChanges
End With

Kill OldName

myFile = Dir$()
Wend

End Sub
'_______________________________________

BUt see point #2, or you will delete a file (The one that gets treated
twice)!

> 2) For some reason the While statement repeats the first saved file. I
> mean 1.doc opens and is saved as say One Little Indian. Then 2.doc is
> saved as Two Little Indians, then 3.doc as Three Little Indians. For
> some reason One Little Indian.doc opens with the SaveAs One Little
> Indian dialog displayed. Any ideas why?

The Dir function is a little buggy for that. I think that as soon as you
start opening files, Windows moves them to the bottom of the directory and
they are processed twice, or such silly reason. You can either have a count
of file before you start and stop the While when the count has run down, or
use doc properties to signify that a file has already been processed.

I think there are other functions of the FileSystem you can use that are
better than Dir.... but sorry, I don't remember off hand right now and I
don't feel like digging in Google...

> 3) The original 1.doc 2.doc and 3.doc files remain in the directory. Can
> these be deleted as part of the VBA code?

With my first version, this is taken care of. Or, use Kill as in the second
one...

Chers!

Signature

Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
jmarcilREMOVE@CAPSsympatico.caTHISTOO
Word MVP site: http://www.word.mvps.org

Reply to this Message

Greg Maxey - 24 Mar 2005 11:33 GMT

JGM,

Thanks. I will have a look at your suggestions and see if I can get it all
to work later today.

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

> Greg Maxey was telling us:
> Greg Maxey nous racontait que :
[quoted text clipped - 173 lines]
>
> Chers!

Reply to this Message

Greg - 24 Mar 2005 14:40 GMT

JGM

I decided to go with your first suggestion and use the counter to
prevent processing the first file twice. The KILL method was
potentially destructive because if you ran the macro a second time it
resulted in all of the files being deleted. My code now.

Option Explicit
Public Sub BatchReNameFiles()

Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim NewName As String
Dim OldName As String
Dim oRng As Range
Dim i As Integer
Dim j As Integer

'Specify folder where files are located
PathToUse = "C:\Batch Folder\"
'Count files in folder
OldName = Dir$(PathToUse & "*.doc")
While OldName <> ""
i = i + 1
OldName = Dir$()
Wend
'Rename files
j = 0
myFile = Dir$(PathToUse & "*.doc")
Do While myFile <> "" And j < i
j = j + 1
Set myDoc = Documents.Open(FileName:=PathToUse & myFile,
Visible:=False)
With myDoc
OldName = .FullName
Set oRng = .Words(1)
oRng.End = .Words(min(9, .Words.Count - 1)).End
NewName = Trim(oRng.Text) & ".doc"
NewName = Replace(NewName, "\", "")
NewName = Replace(NewName, ":", "")
NewName = Replace(NewName, """", "")
NewName = Replace(NewName, vbCr, "")
NewName = Replace(NewName, vbTab, "")
.Close SaveChanges:=wdSaveChanges
End With
Name OldName As PathToUse & NewName
myFile = Dir$()
Loop

End Sub
Private Function min(a As Long, b As Long)
min = -((a < b) * a + (a >= b) * b)
End Function

Thanks Jay, Doug. JGM for your code snippets and assistance.

Reply to this Message

David Sisson - 24 Mar 2005 16:58 GMT

Whenever I deal with DIR in reading multiple files, I always pull
everything into a array and work from there. At least I know I have
built a directory list based on search criteria that DOS isn't going to
update.

My $0.02.

David

Reply to this Message

Greg - 24 Mar 2005 17:30 GMT

David,

VBA is like Russian to me. I can repeat the words I know and sometimes
I can arrange those words in a sequence to express an idea. Still I
don't speak the language. Could you provide an example of how you:

Pull everything into an array and work from there.

Thanks.

Reply to this Message

David Sisson - 24 Mar 2005 19:06 GMT

Something like this:

http://word.mvps.org/faqs/macrosvba/ReadFilesIntoArray.htm

Once you have your array populated, you now have a KNOWN list of files
matching the search criteria and as you iterate through the list, you
know it not going to change.

Search for 'directory array' and you'll find yet another test in the
dir$ loop using vbDirectory for weed out subdirectories.

Again, just a different approach.

David

Reply to this Message

Greg - 24 Mar 2005 19:54 GMT

Ok, I suppose I should have known about that MVP FAQ. Thanks. I will
have a look at it.

Reply to this Message

Greg Maxey - 25 Mar 2005 00:11 GMT

David,

Is something like the method you were discussing:

Sub BacthFileRenamer()
Dim MyFile As String
Dim PathToUse As String
Dim Counter As Long
Dim myDoc As Document
Dim NewName As String
Dim OldName As String
Dim oRng As Range

'Create a dynamic array variable, and then declare its initial size
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000) '1000 is arbitrary

'Specify folder containing files
PathToUse = "C:\Batch Folder\"
'Loop through all the files of *.doc in the directory by using Dir$
function
MyFile = Dir$(PathToUse & "*.doc")
'For each file found add to the array
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
'Get the next file name
MyFile = Dir$
Counter = Counter + 1
Loop

'Reset the size of the array without losing its values by using Redim
Preserve
ReDim Preserve DirectoryListArray(Counter - 1)
Application.ScreenUpdating = False
For Counter = 0 To UBound(DirectoryListArray)
Set myDoc = Documents.Open(FileName:=PathToUse &
DirectoryListArray(Counter), _
Visible:=False)
With myDoc
OldName = .FullName
Set oRng = .Words(1)
oRng.End = .Words(min(9, .Words.Count - 1)).End
NewName = Trim(oRng.Text) & ".doc"
NewName = Replace(NewName, "\", "")
NewName = Replace(NewName, ":", "")
NewName = Replace(NewName, """", "")
NewName = Replace(NewName, vbCr, "")
NewName = Replace(NewName, vbTab, "")
.Close SaveChanges:=wdSaveChanges
End With
Name OldName As PathToUse & NewName
Next Counter
Application.ScreenUpdating = True
End Sub
Private Function min(a As Long, b As Long)
min = -((a < b) * a + (a >= b) * b)
End Function

This bit here:

Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
'Get the next file name
MyFile = Dir$
Counter = Counter + 1
Loop

Can someone explain (again) the significance of the dollar sign. Why don't
I have to repeat the whole line?
Dir$(PathToUse & "*.doc")

Signature

Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

> Something like this:
>
[quoted text clipped - 10 lines]
>
> David

Reply to this Message