saving in 2 different places : VBA

[bamaisgreat]

The workbook I am using is saved on the network and also were i save it also located on the network. The problem im having is that sometimes out network connection may go down, and when this happens the application still remains on the computer, when some one enters info on it they do not realize that it is not going to save. The module below is what i use..

Sub STOCK_FORM_SEND()
'THIS  IS ONLY FOR SEND BUTTON ON CUTTING FORM. HIDE BUTTONS ARE DIFFERENT
'
'
If Dir("H:\") = "" Then
    UserForm1.Label1.Caption = "Error: No Network Connection"
Else
    UserForm1.Label1.Caption = "Network Connection Found ! Preparing to Send........"
End If
UserForm1.Show vbModeless
Application.Wait Now + TimeSerial(0, 0, 5)
Unload UserForm1

    If MsgBox("By pressing  Yes  you confirm that all information entered is correct.", _
    vbCritical + vbYesNo, "") = vbNo Then Exit Sub
    ActiveSheet.Unprotect
    Dim ButtonName As Variant
    Dim ButtonNames As Variant
    
'   Change/add button names accordingly
    ButtonNames = Array("Button 7", "Button 8", "Button 2")
    
    For Each ButtonName In ButtonNames
    ActiveSheet.Buttons(ButtonName).Visible = False
    Next ButtonName

   
    
    
    Range("H24").Select
    Selection.Interior.ColorIndex = 6
    ActiveCell.FormulaR1C1 = "OPERATOR CHECKED"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .name = "Arial"
        .FontStyle = "Bold"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
   
    With Range("A4:e22").Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    With Range("g4:n22").Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    
    With Range("p4:p22").Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    
   With Range("r4:t22").Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    
    Range("H20").Select
    ActiveWorkbook.Save
    ActiveWindow.SmallScroll Down:=-6
    Range("I4").Select
    
    
    
    
    
    
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWorkbook.Save
    
        Const sPath     As String = "H:\Burney Table\Tester\Operators Form\Tester Final\"
    Const sFile     As String = "Tester Stock"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs _
            Filename:=sPath & Format(Now(), "yyyy-mm-dd hhmmss ") & sFile, _
            FileFormat:=xlNormal
    
    
'    ActiveWorkbook.SaveAs Filename:="H:\Burney Table\Tester\Operators Form\Tester Final\" & _
 '   Format(Now(), "mm-dd-yyyy hh-mm-ss") & "   TESTER STOCK", FileFormat:=xlNormal _
  '  , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
   ' CreateBackup:=False
    
    ButtonNames = Array("Button 8")
    
    For Each ButtonName In ButtonNames
    ActiveSheet.Buttons(ButtonName).Visible = False
    Next ButtonName
    ActiveWorkbook.Save
    
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "H:\Burney Table\Tester\Operators Form\Tester Pdf\" & Format(Now(), "mm-dd-yyyy hh-mm-ss") & "   TESTER STOCK.pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
    
    
    ActiveWorkbook.Save
    ActiveSheet.Unprotect
    
          
    With Range("$H$1:$K$1")
   .Locked = False
   .FormulaHidden = False
    End With
    
    'Cells.Select
    ActiveSheet.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
    'ActiveSheet.EnableSelection = xlNoSelection
    'Cells.Select
    ActiveWorkbook.Save
    
    Workbooks.Open ("H:\Burney Table\Tester\Operators Form\Tester.xls")
    Windows("Tester.xls").Activate
    
    'Application.WindowState = xlMinimized
    'ActiveWorkbook.Save
    'Application.Quit
    'Application.Close
    'ActiveWorkbook.Close
    ThisWorkbook.Close SaveChanges = True
    
   Application.Quit
End Sub