You can incorporate some of the code from one of these sites:
Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)
John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm
Your main routine will be:
Option Explicit
Sub testme01()
Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myOldPath As String
Dim myNewPath As String
Dim MstrFileName As String
Dim TempWkbk As Workbook
'change to point at the old folder
myOldPath = GetDirectory("Select OLD Folder")
If myOldPath = "" Then Exit Sub
If Right(myOldPath, 1) <> "\" Then
myOldPath = myOldPath & "\"
End If
'change to point at the new folder
myNewPath = GetDirectory("Select NEW Folder")
If myNewPath = "" Then Exit Sub
If Right(myNewPath, 1) <> "\" Then
myNewPath = myNewPath & "\"
End If
MstrFileName = "mstr.xls"
myFile = ""
On Error Resume Next
myFile = Dir(myOldPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If
Application.ScreenUpdating = False
'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop
If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
If LCase(myNames(fCtr)) = LCase(MstrFileName) Then
'do nothing, skip the master file
Else
Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now
Set TempWkbk = Workbooks.Open(Filename:=myOldPath _
& myNames(fCtr), ReadOnly:=True)
TempWkbk.SaveAs Filename:=myNewPath & myNames(fCtr)
TempWkbk.Close savechanges:=False
End If
Next fCtr
End If
With Application
.ScreenUpdating = True
.StatusBar = False
End With
End Sub
But in a different module, put all this code (From John Walkenbach's site):
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
> Dave -- Thank you for your assistance -- the code worked brillantly! It's
> Friday, so I hate to press my luck on this one, but is it possible to modify
[quoted text clipped - 113 lines]
> >
> > Dave Peterson

Signature
Dave Peterson
doctorjones_md - 12 Jul 2006 10:59 GMT
Dave -- sorry the the delayed response to your follow-up assistance (with
the Browse To Option from John Walkenbach's site) -- this works
Brillantly" -- many thanks to you for all your assistance! :)
> You can incorporate some of the code from one of these sites:
>
[quoted text clipped - 265 lines]
>> >
>> > Dave Peterson