Not allowing certain users to save when a Macro has been used

[James0610]

I would be VERY grateful if anyone could advise on the following. I have a sheet used by multiple users (usually on a remote network) - the file works perfectly for 75% of users by will not allow other users to save the file.

The Macro i use is:

Sub Macro12()
'
' Macro12 Macro
'
' Sheets("Request Entry Form").Select
Range("B2:W2").Select
ActiveSheet.Unprotect
Sheets("DO NOT OPEN").Select
Rows("10:10").Select
Selection.Copy
Rows("11:11").Select
Selection.Insert Shift:=xlDown
Range("B10:BN10").Select
Application.CutCopyMode = False
Selection.Copy
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A11").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[1]C+1"
Range("A12").Select

Sheets("Request Entry Form").Select
Range("T6").Select
ActiveCell.FormulaR1C1 = "='DO NOT OPEN'!R[5]C[-19]"
Range("T6").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Sheets("Request Entry Form").Copy
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You answered NO in the security dialog."
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Expenses Request " & Format(Now, "dd-mmm-yy h-mm-ss")
Sheets("Request Entry Form").Select
ActiveSheet.Shapes.Range(Array("Button 2")).Select
Selection.Delete
ActiveWindow.SmallScroll Down:=-105
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Delete

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next

With OutMail
.To = "abc@afoods.com"
.CC = Workbooks("Expense Claim Database - August 2012").Worksheets("Request Entry Form").Range("T4")
.BCC = Workbooks("Expense Claim Database - August 2012").Worksheets("Request Entry Form").Range("U4")
.Subject = "Approval required for new Expenses Claim Form"
.HTMLBody = "An expenses claim form has been submitted which requires your authorisation. Please find attached a copy of the claim form and once satisfied follow the link below to authorise. Regards, Expenses Database" & vbNewLine & vbNewLine & "file:///G:\Sales\Expense Claim Forms\August 2012\" & vbNewLine
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Dim wks As Worksheet
Dim fname
Dim path
Set wks = Worksheets("Request Entry Form")
path = "G:\Finance\TEST E\August 2012\Expense Claim - August 2012 - "
fname = CStr(wks.Range("T6").Value)
ActiveWorkbook.SaveAs Filename:=path & fname, FileFormat:=52

Kill (TempFilePath & TempFileName & FileExtStr)
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Windows("Expense Claim Database - August 2012.xlsm").Activate
Sheets("Request Entry Form").Range("C4").ClearContents
Sheets("Request Entry Form").Range("H4").ClearContents
Sheets("Request Entry Form").Range("C6").ClearContents
Sheets("Request Entry Form").Range("H6").ClearContents
Sheets("Request Entry Form").Range("T6").ClearContents
Sheets("Request Entry Form").Range("B11:S30").ClearContents
Sheets("Request Entry Form").Range("V11:V30").ClearContents
Sheets("Request Entry Form").Range("T38").ClearContents
Sheets("Request Entry Form").Range("T39").ClearContents
Sheets("Request Entry Form").Range("R44").ClearContents
Sheets("Request Entry Form").Range("W88").ClearContents
Sheets("Request Entry Form").Range("B62:T84").ClearContents
Sheets("Request Entry Form").Range("V62:V84").ClearContents
Sheets("Request Entry Form").Range("M88:M92").ClearContents

Range("C4").Select
ActiveCell.Value = "Insert Name"
Range("C6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.save

End Sub


The Macro sends the email and saves the copy file for all users, however it falls down on the very final line of the Macro (ActiveWorkbook.save) - I have also tried using an ActiveWorkbook.saveas function and this also fails.

It randomly will not save the file for users at random times......I have tried everything I can think of, my thoughts are:

- Could it be lost internet signal from the remote PC (but it seems to happen too much to indicate this)
- Could it be individual settings (but we all have the same settings)

I would be very grateful if anyone has any ideas.
Thanks,.

James