VBA Problem - Please Help

[SU]

I have a spreadsheet where the users input their Username and the file is
saved automatically using the loginname. Everything seems to work fine except
that when I save the file through File>Close command both prompts (see below)
keeps on appearing in a loop.

Please please suggest a solution. Many thanks in advance.

If required, I could send a dummy file to check the codes.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'a = MsgBox("Do you really want to save the workbook?", vbYesNo)
' If a = vbNo Then Cancel = True
Dim Response, MyString, Msg, Style, Title, Help, Ctxt
Dim MyFileName As String
Const SaveSheet As String = "Jan"
Const SaveCell As String = "Z24"
Dim wb As Workbook
Set wb = ActiveWorkbook
'
'Cancel Save event
Cancel = False
'
'Create string variable for file name
Dim strFName As String
'Set file path in string
strFName = Sheets("Jan").Range("Z24").Value
'Check if V23 - UserName is empty
If wb.Worksheets("Jan").Range("V23") <> "" Then
'Cancel Save event
Cancel = True
'If not, then verify UserName
If MsgBox("Your UserName is (" & Sheets("Jan").Range("V23").Value & "),"
& _
vbCrLf & " Is this Correct?", vbYesNo, "Save Prompt") = vbYes Then
'If name is correct, Save file
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs strFName
Application.EnableEvents = True
Application.DisplayAlerts = True
Else
'If UserName is NOT correct, prompt to change it
MsgBox "Please enter CORRECT UserName"
End If
Else
'Prompt for UserName
MsgBox "You have not entered your UserName" & vbCrLf & _
"on the first sheet (" & SaveSheet & "), in cell (V23)"
End If
End Sub

 

[JLGWhiz]

Since you are already in the process of saving the file, which calls the
"BeforeSave" routine, wouldn't having another save command in the routine
cause a loop? I have never used this procedure, so I am not sure about the
effect, but it is the only thing that I see that might cause the problem. It
seems that if you have no reason to cancel the original save command, then
just let it go ahead without giving it a second command.

 

[SU]

What would you suggest I do as an alternative?

Since you are already in the process of saving the file, which calls the
"BeforeSave" routine, wouldn't having another save command in the routine
cause a loop? I have never used this procedure, so I am not sure about the
effect, but it is the only thing that I see that might cause the problem. It
seems that if you have no reason to cancel the original save command, then
just let it go ahead without giving it a second command.

 

[ct60]

Hi SU -

I think the issue is with your use of the Cancel which produces an infinite
loop.

Try the following (see notes in CAPITALS):

strFName = Sheets("Jan").Range("Z24").Value
'Check if V23 - UserName is empty
' NOTE: I THINK YOU SHOULD ADD A CHECK HERE TO SEE IF THIS VALUE (Z24) IS
' EMPTY, BUT THAT IS NOT WHAT IS CAUSING THE PROBLEM
If wb.Worksheets("Jan").Range("V23") <> "" Then
'If not, then verify UserName
If MsgBox("Your UserName is (" & Sheets("Jan").Range("V23").Value & ")," & _
vbCrLf & " Is this Correct?", vbYesNo, "Save Prompt") = vbYes Then
'If name is correct, Save file
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs strFName
Application.EnableEvents = True
Application.DisplayAlerts = True
Else
'If UserName is NOT correct, prompt to change it
MsgBox "Please enter CORRECT UserName"
'Cancel Save event
' PLACE CANCEL=TRUE HERE WHERE YOU WANT TO CANCEL THE SAVE
Cancel = True
End If
Else
'Prompt for UserName
MsgBox "You have not entered your UserName" & vbCrLf & _
"on the first sheet (" & SaveSheet & "), in cell (V23)"
'Cancel Save event
' AND HERE AS WELL
Cancel = True

End If

This eliminates the infinite loop. Like I noted above you should probably
add a check if Sheets("Jan").Range("Z24").Value is not blank although this
should work even if it is blank.

Hope that helps.

Chris ([email protected])

 

[SU]

Chris
Many many thanks for your help. It works and solved that problem.

However, it opened up another problem - I DO NOT want any user to be able to
save this file in any other name format than the prescribed one. I do not
want them to be able to use SAVE AS.

Prior to your suggestions, if the user used SAVE AS it would have saved the
file as SAVE. But now SAVE IS active again.

Can you please help again to use 'SAVE AS' as before.

Many thanks again.

 

[ct60]

Hi SU -

Sorry i did not see your post before today, but you notice that the before
workbook save event has a parameter "saveasUI" which is a boolean (true or
false value) which indicates if save-as is being used. This can be disabled
as follows:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'a = MsgBox("Do you really want to save the workbook?", vbYesNo)
' If a = vbNo Then Cancel = True
Dim Response, MyString, Msg, Style, Title, Help, Ctxt
Dim MyFileName As String
Const SaveSheet As String = "Jan"
Const SaveCell As String = "Z24"
Dim wb As Workbook
Set wb = ActiveWorkbook
'
' You may need to add some kind of check here unless you want to absolutely
' disable save-As in all instances. Perhaps you can allow one save as if
the filename
' is something like "workbook1". In any case, here is the basic idea:
If SaveAsUI = True Then
MsgBox "Save-As has been disabled. Please use save only.", vbInformation
Cancel = True
Exit Sub
End If

' Same as before
'Create string variable for file name
Dim strFName As String
'Set file path in string
strFName = Sheets("Jan").Range("Z24").Value
'Check if V23 - UserName is empty
If wb.Worksheets("Jan").Range("V23") <> "" Then
'Cancel Save event
Cancel = True
'If not, then verify UserName
If MsgBox("Your UserName is (" & Sheets("Jan").Range("V23").Value & ")," & _
vbCrLf & " Is this Correct?", vbYesNo, "Save Prompt") = vbYes Then
'If name is correct, Save file
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs strFName
Application.EnableEvents = True
Application.DisplayAlerts = True
Else
'If UserName is NOT correct, prompt to change it
MsgBox "Please enter CORRECT UserName"
Cancel = False
End If
Else
'Prompt for UserName
MsgBox "You have not entered your UserName" & vbCrLf & _
"on the first sheet (" & SaveSheet & "), in cell (V23)"

Cancel = False
End If
End Sub

Hope that helps,

Chris