Quite right Jim. Requirement is to force filename but be flexible on path:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Static blnSaving As Boolean
Dim strFileName As String, strIdentifier As String, i As Long, j As Long

If blnSaving Then
blnSaving = False
Else
Cancel = True
If MsgBox("Are sure you want to save this workbook?", vbYesNo) =
vbYes Then
strIdentifier = "TCR" & Cells(20, 29) & ".xls"
strFileName = Application.GetSaveAsFilename(strIdentifier,
fileFilter:="Excel Files (*.xls),*.xls")
If strFileName < "False" Then
i = 0: Do: j = i: i = InStr(i + 1, strFileName,
Application.PathSeparator): Loop Until i = 0
blnSaving = True
ThisWorkbook.SaveAs Mid(strFileName, 1, j) & strIdentifier
End If
End If
End If

End Sub


"Jim Cone" wrote in message
...
Bill,

Building on the code that Rob provided, see if this does it for you...

'=============================================
Private blnWantToSave As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
If blnWantToSave Then
blnWantToSave = False
Else
Dim FileSaveName As String
Dim lngPlace As Long

If MsgBox("Are sure you want to save this workbook? ", _
vbYesNo + vbQuestion, "Question from Bill") = vbNo Then
blnWantToSave = False
Cancel = True
Exit Sub
Else
Cancel = True
FileSaveName = _
Application.GetSaveAsFilename("TCR" & Cells(20, 29).Value & _
".xls",fileFilter:="Excel Files (*.xls),*.xls")
End If
'Call function
lngPlace = LASTPOSITION(FileSaveName, "\")
'Replace user specified file name with preferred name.
FileSaveName = _
Left$(FileSaveName, lngPlace) & "TCR" & Cells(20, 29).Value & ".xls"
blnWantToSave = True
ActiveWorkbook.SaveAs Filename:=FileSaveName
'Let user know you changed the file name.
MsgBox "File saved under the following name..." & vbCr _
& FileSaveName, vbInformation, "Bill Made Me Do It"
End If
End Sub


'================================================= ==========================
=============
' Counts the position in a string of a user provided character.
' Written by James Cone - September 2003.

'================================================= ==========================
=============
Function LASTPOSITION(ByRef strInput As String, _
ByRef strChar As String) As
Long
On Error GoTo WrongPosition
Dim lngPos As Long
Dim lngCnt As Long
Dim lngLength As Long

lngPos = 1
lngLength = Len(strChar)

Do
lngPos = InStr(lngPos, strInput, strChar, vbTextCompare)
If lngPos Then
lngCnt = lngPos
lngPos = lngPos + lngLength
End If
Loop While lngPos 0
LASTPOSITION = lngCnt
Exit Function

WrongPosition:
Beep
LASTPOSITION = 0
End Function


'================================================= ==========================
=============
Regards,
Jim Cone
San Francisco, CA


"Bill Oertell" wrote in message
...
I'm having trouble getting this code to work. The dialog box come up
and
you can navigate to the directory you want, but the file still saves to
the
original file name in the original directory.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
a = MsgBox("Are sure you want to save this workbook?", vbYesNo)
If a = vbNo Then
Cancel = True
Else
SaveAsUI = True
fileSaveName = _
Application.GetSaveAsFilename("TCR" & Cells(20, 29) &
".xls", fileFilter:="Excel Files (*.xls),*.xls")
End If
End sub

What I want to do is force the user to save the file as TCR plus
whatever
is in cell AC20, ie TCRSomeone.xls, but I'd like them to be able to save
it
in
the directory they choose.