Workbook_BeforeSave - SaveAsUI value wrong

[kmcclaff]

A co-worker's computer recently had some software removed and afterward they noticed that the Workbook_BeforeSave routine would not work properly.

I traced the problem to the SaveAsUI = True even though the user clicked File Save, not File Save As.

Anyone have any ideas how the SaveAsUI variable could get messed up?

[si_the_geek]

Thread moved to Office Development/VBA forum (note that the "VB Editor" in Office programs is actually VBA rather than VB, so the VB6 forum is not really apt)

[RobDog888]

Its probably not being used properly. Can you post up the code?

SaveAsUI should be used with the GetSaveAsFilename function for when you want to override the filename and path to save the workbook as.

[kmcclaff]

Here is the code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sPath As String, i As Integer, findslash As String, part_name As String
Dim msg, Style, Title, Help, Ctxt, Response, MyString, datemonth As Variant, dateday As Integer, dateforfile As String
Dim desired_name As Variant, OKtoHide As Integer, readyflag As String, PriorityFlag As String
Dim c As String, Z As String, PFflag As String
Dim fexten As Variant
Dim actual_name As String, rstring As String, k As Integer
If ginloop2 Then Exit Sub
vexcel = ExcelVersion
If vexcel >= 12 Then
   actual_name = ActiveWorkbook.Name
   rstring = Right(actual_name, 5)
   k = InStr(rstring, ".")
   If k = 1 Then   ' have a 4 character file extension
       msg = "PLEASE NOTE:  This file must be saved in Excel 2003 format with the .xls extension." & Chr(13) & Chr(13)
       msg = msg & "This file is NOT ready to send to Ford in its current format."
       Style = 16    ' Define buttons.
       Title = "File Format Error"    ' Define title.
       Response = MsgBox(msg, Style, Title)
   End If
End If
gbInLoop = True
ginsave = True
Sheets("Sheet1").Activate
' construct date tag for file
datemonth = MonthName(Month(Now), True)
dateday = Day(Now)
dateforfile = dateday & datemonth
    
If Sheet1.chkPrioritySiteToggle = False Then
    PriorityFlag = "NP_"
Else
    PriorityFlag = "P_"
End If
    ' let user know if pre-assessment is turned on
If Sheet1.Range("BC1").Value = True Then
    PFflag = "Pre_"
Else
    PFflag = "Fin_"
End If
Application.ScreenUpdating = False
    ' if Save button is clicked, then compare desired_name to actual_name
    ' if they are different, save file as desired_name under current path and
    ' give message to user with path and naming convention rules
    ' else, then do nothing (make sure Save occurs correctly)
 
    ' if SaveAs button is clicked, then compare desired_name to actual_name
    ' if they are different, save file as desired_name under current path and
    ' give message to user with path and naming convention rules
    ' else, let user remain in SaveAs dialog box to same to a different name or location or both
OKtoHide = CheckNotEmpty("C5") + CheckNotEmpty("C7") + CheckNotEmpty("C3") + CheckNotEmpty("L5") + CheckNotEmpty("S6")
If Sheet1.cmbMilestone.Value <> "" And Sheet1.cmbPMT.Value <> "" And Sheet1.cmbPartition.Value <> "" And OKtoHide = 0 Then  ' Do not hide rows - have enough Program Info to construct filename
    If Len(Sheet1.Range("S6").Value) > 20 Then
        part_name = UCase(Mid(Sheet1.Range("S6").Value, 1, 20))
    Else
        part_name = UCase(Mid(Sheet1.Range("S6").Value, 1, Len(Sheet1.Range("S6").Value)))
    End If
    If CheckForReady = True Or (CheckForReady = False And gfextension = True And gReady = True) Then
        readyflag = "R_"
    Else
        readyflag = "NR_"
    End If
    ' assign desired_name without .xls extension
    desired_name = PFflag & readyflag & UCase(Sheet1.Range("C5").Value) & "_" & Sheet1.cmbMilestone.Value & "_" & UCase(Sheet1.Range("L5").Value) & "_" & PriorityFlag & Sheet1.Range("C7").Value & "_" & part_name & "_" & dateforfile
    c = "-"
    For k = 1 To 9
        Select Case k
            Case 1: Z = "\"
            Case 2: Z = "/"
            Case 3: Z = ":"
            Case 4: Z = "*"
            Case 5: Z = "?"
            Case 6: Z = """"
            Case 7: Z = "<"
            Case 8: Z = ">"
            Case 9: Z = "|"
        End Select
        desired_name = Replace(desired_name, Z, c)
    Next k
    ' replace blanks with null
    desired_name = Replace(desired_name, " ", "")
    
    desired_name = desired_name & ".xls"
    actual_name = ActiveWorkbook.Name
    If actual_name <> desired_name And (SaveAsUI = False Or vexcel >= 12) Then
        ginloop2 = True
        gmileflag = True
        
        msg = "The current file will be saved using the Ford Schedule A naming convention:" & Chr(13) & Chr(13)
        msg = msg & "'" & desired_name & "'" & Chr(13) & Chr(13)
        msg = msg & "The file will be saved to the path" & Chr(13)
        msg = msg & ActiveWorkbook.Path & Chr(13)
        If ginclose1 = False Then
            If SaveAsUI = False Then
                msg = msg & Chr(13) & "If you wish to save it to a different location/name, click File, Save As" & Chr(13)
            End If
        End If
        If vexcel >= 12 Then
            msg = msg & Chr(13) & "PLEASE NOTE:  The file must be saved in Excel 2003 format." & Chr(13)
        End If
        Style = vbOKOnly    ' Define buttons.
        Title = "File Naming Convention Check"    ' Define title.
        Response = MsgBox(msg, Style, Title)
        On Error GoTo 100
        ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & desired_name, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    End If
    
    If SaveAsUI = True Then
        gmileflag = True
        gsaveas = True
        gactive = False
    ElseIf ginclose2 = False Then
        Cancel = True
        ginloop2 = True
        ActiveWorkbook.Save
        gactive = False
    End If
    
ElseIf SaveAsUI = True Then
    gmileflag = True
    gsaveas = True
    gactive = False
Else
    ginloop2 = True
    ActiveWorkbook.Save
    gactive = False
    ginloop2 = False
    ginsave = False
End If
100
gbInLoop = False
ginloop2 = False
ginsave = False
gactive = False
 
 End Sub

[kmcclaff]

We found a solution to this problem. Our help desk had to recreate a new user profile for the user and it corrected the problem.