|
Public Sub ErrorTrap1()
Dim Answer As Long, MyFile As String
Dim Message As String, CurrentPath As String
On Error GoTo errTrap
CurrentPath = CurDir$
ChDrive "A"
ChDrive CurrentPath
ChDir CurrentPath
MyFile = "A:\Data.xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyFile
TidyUp:
ChDrive CurrentPath
ChDir CurrentPath
Exit Sub
errTrap:
Message = "Error No: = " & Err.Number & vbCr
Message = Message & Err.Description & vbCr & vbCr
Message = Message & "Please place a disk in the A: drive" & vbCr
Message = Message & "and press OK" & vbCr & vbCr
Message = Message & "Or press Cancel to abort File Save"
Answer = MsgBox(Message, vbQuestion + vbOKCancel, "Error")
If Answer = vbCancel Then Resume TidyUp
Resume
End Sub
|