I have a workbook that is read only so can't be saved. When the users does
'save as' how can I add a letter to the beginning of whatever filename he
chooses. It will be the same letter each time.

M

You can give this a try...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFileName As String
Dim lngLastSlash As Long
If SaveAsUI = True Then
Cancel = True
strFileName = Application.GetSaveAsFilename
lngLastSlash = InStrRev(strFileName, "\")
strFileName = Left(strFileName, lngLastSlash) & "Z" &
Mid(strFileName, lngLastSlash + 1, 256)
ThisWorkbook.SaveAs strFileName
End If
End Sub
--
HTH...

Jim Thomlinson


"Mike H" wrote:

I have a workbook that is read only so can't be saved. When the users does
'save as' how can I add a letter to the beginning of whatever filename he
chooses. It will be the same letter each time.

M

Jim,

Perfect, thank you.

Mike

"Jim Thomlinson" wrote:

You can give this a try...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFileName As String
Dim lngLastSlash As Long
If SaveAsUI = True Then
Cancel = True
strFileName = Application.GetSaveAsFilename
lngLastSlash = InStrRev(strFileName, "\")
strFileName = Left(strFileName, lngLastSlash) & "Z" &
Mid(strFileName, lngLastSlash + 1, 256)
ThisWorkbook.SaveAs strFileName
End If
End Sub
--
HTH...

Jim Thomlinson


"Mike H" wrote:

I have a workbook that is read only so can't be saved. When the users does
'save as' how can I add a letter to the beginning of whatever filename he
chooses. It will be the same letter each time.

M

Mike,

Try something like this in the Thisworkbook code module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFile As String
Dim iReply As Integer

Cancel = True
iReply = vbYes

'Check if read only
If ThisWorkbook.ReadOnly Then
Do
strFile = Application.GetSaveAsFilename
If strFile = "False" Then Exit Sub 'user cancelled

'Add "X" to the file name
strFile = Mid(strFile, 1, InStrRev(strFile, "\")) & "X" &
Mid(strFile, InStrRev(strFile, "\") + 1)

'Check if file exists
If Dir(strFile) < "" Then
iReply = MsgBox(strFile & " already exists! Overwrite?",
vbYesNo)
End If
Loop While iReply = vbNo

'Save it
Application.EnableEvents = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strFile
Application.DisplayAlerts = True
Application.EnableEvents = True

End If
End Sub



--
Hope that helps.

Vergel Adriano


"Mike H" wrote:

I have a workbook that is read only so can't be saved. When the users does
'save as' how can I add a letter to the beginning of whatever filename he
chooses. It will be the same letter each time.

M

... correction.. Cancel=True line should be inside the If statement..

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFile As String
Dim iReply As Integer

iReply = vbYes

'Check if read only
If ThisWorkbook.ReadOnly Then
Cancel = True

Do
strFile = Application.GetSaveAsFilename
If strFile = "False" Then Exit Sub 'user cancelled

'Add "X" to the file name
strFile = Mid(strFile, 1, InStrRev(strFile, "\")) & "X" &
Mid(strFile, InStrRev(strFile, "\") + 1)

'Check if file exists
If Dir(strFile) < "" Then
iReply = MsgBox(strFile & " already exists! Overwrite?",
vbYesNo)
End If
Loop While iReply = vbNo

'Save it
Application.EnableEvents = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strFile
Application.DisplayAlerts = True
Application.EnableEvents = True

End If
End Sub



--
Hope that helps.

Vergel Adriano


"Vergel Adriano" wrote:

Mike,

Try something like this in the Thisworkbook code module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFile As String
Dim iReply As Integer

Cancel = True
iReply = vbYes

'Check if read only
If ThisWorkbook.ReadOnly Then
Do
strFile = Application.GetSaveAsFilename
If strFile = "False" Then Exit Sub 'user cancelled

'Add "X" to the file name
strFile = Mid(strFile, 1, InStrRev(strFile, "\")) & "X" &
Mid(strFile, InStrRev(strFile, "\") + 1)

'Check if file exists
If Dir(strFile) < "" Then
iReply = MsgBox(strFile & " already exists! Overwrite?",
vbYesNo)
End If
Loop While iReply = vbNo

'Save it
Application.EnableEvents = False
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strFile
Application.DisplayAlerts = True
Application.EnableEvents = True

End If
End Sub



--
Hope that helps.

Vergel Adriano


"Mike H" wrote:

I have a workbook that is read only so can't be saved. When the users does
'save as' how can I add a letter to the beginning of whatever filename he
chooses. It will be the same letter each time.

M