SaveAs crash excel on Network

T

to.izahid

Hi Fellows,
I created a template workbook (name starts with "M_") that has a
sheet with "Version & Revision" log. What I wanted to do is to
update the template file name with the latest Version & Revision info
whenever it gets changed and ignore this info if it is a test file
(generated from template).

The following code that I assembled together (thanks to various authors
on this group) works fine if the template is on my hard drive, meaning
I could open the template, change the Version or Revision and click
save and it reflects the changes in the file name, however, the same
file crash excel on the network during save event.

The file doesn't have any read or write protection and I already
verified the length of the path is less than 256 charac.

Any help would be greatly appreciated.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

'Cancel Excel 's save and replace it with mine.
Cancel = True

' prevent file from being saved elsewhere
If SaveAsUI = True Then
MsgBox "Restriction on FileSaveAs location!", vbCritical
Cancel = True
Exit Sub
End If

Application.EnableEvents = False

If Mid(CStr(ThisWorkbook.Name), 1, 2) = "M_" Then
RevisionLog
Else
ThisWorkbook.Save 'don't update the Rev Level for Proj Files
End If

Application.EnableEvents = True

'prevent save message poping twice - Before_Close & Before_Save
Me.Saved = True

End Sub

Public Sub RevisionLog()
Dim LrowVer As Long
Dim LrowRev As Long
Dim LrowRDt As Long
Dim strrev As String 'Revision
Dim strver As String 'Version
Dim strRDt As String 'Rev Date
Dim strNewFileNm As String

Application.ScreenUpdating = False
On Error GoTo ErrHandler

strFileNm = ThisWorkbook.Name

'file name is like M_xxxxx_v(2.0)_r(Original).xls
'function to separate "M_xxxxx_" from the file name

strNewFileNm = SplitFileName("(", strFileNm)
With Worksheets("Rev_Level")
LrowVer = .Cells(Rows.Count, 1).End(xlUp).Row
LrowRev = .Cells(Rows.Count, 2).End(xlUp).Row
LrowRDt = .Cells(Rows.Count, 9).End(xlUp).Row

'Find latest Version
If LrowVer < 2 Then
strver = "1.0"
.Unprotect password:=Range(strPwd).Value
.Cells(LrowVer, 1).Offset(1, 0).Value = strver
Else
strver = .Cells(LrowVer, 1)
End If

'Find latest Revision
If LrowRev < 2 Then
strrev = "Original"
.Unprotect password:=Range(strPwd).Value
.Cells(LrowRev, 2).Offset(1, 0).Value = strrev
Else
strrev = .Cells(LrowRev, 2)
End If
.PageSetup.RightFooter = "Revision Date: " & strRDt
End With

Application.DisplayAlerts = False
ThisWorkbook.SaveAs _
filename:=ThisWorkbook.Path & Application.PathSeparator &
strNewFileNm _
& "_v(" & strver & ")_r(" & strrev & ").xls"
Application.DisplayAlerts = True

Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description

End Sub
 
Top