Hi All,
I would really appreciate some help on this as my VB skills are not
good, I can often work with code from this group,but I am stuck on
this.

the code below will save a copy of a worksheet to the H Drive with a
file name with sheet name (paddock), cell reference and date time .xls
My problem is to check if H drive exists, then if it does not exist,
to prompt to SAVE As for user input to select another file on C drive
with the given file name.

appreciate any help on this.

here is the code.

Sub SaveASPaddock()


'This macro will SAVE AS to H:\ folder, which must exist before macro
runs
ActiveSheet.Unprotect
Sheets("Paddock").Select
Range("A3").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Range("A1").Select

Application.CutCopyMode = False
ActiveWorkbook.SaveAsApplication.GetSaveAsFilename "H:\" &
"PaddockFee_" & Range("D1").Value & "_" & Format(Now, "yyyymmddhhmm")
& ".xls"


ActiveWorkbook.Close SaveChanges:=False

Sheets("Paddock").Select
Range("A3").Select
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Thanks in advance
Cheers Paul

You can check for the existence of a drive using the FileSystemObject...
'--
Function DriveStatus(drv As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
DriveStatus = fso.DriveExists(drv)
Set fso = Nothing
End Function
'--

So...
If DriveStatus("H") = True Then
'save file
Else
'chose another drive
End If
--
Jim Cone
Portland, Oregon USA




"Paul"
wrote in message
Hi All,
I would really appreciate some help on this as my VB skills are not
good, I can often work with code from this group,but I am stuck on
this.

the code below will save a copy of a worksheet to the H Drive with a
file name with sheet name (paddock), cell reference and date time .xls
My problem is to check if H drive exists, then if it does not exist,
to prompt to SAVE As for user input to select another file on C drive
with the given file name.
appreciate any help on this.
here is the code.

Sub SaveASPaddock()
'This macro will SAVE AS to H:\ folder, which must exist before macro
runs
ActiveSheet.Unprotect
Sheets("Paddock").Select
Range("A3").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAsApplication.GetSaveAsFilename "H:\" &
"PaddockFee_" & Range("D1").Value & "_" & Format(Now, "yyyymmddhhmm")
& ".xls"
ActiveWorkbook.Close SaveChanges:=False
Sheets("Paddock").Select
Range("A3").Select
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Thanks in advance
Cheers Paul

thanks Jim
Appreciate the asisstance here.
Trying out this code now.
Cheers Paul

On Dec 18, 11:39*am, "Jim Cone" wrote:
You can check for the existence of a drive using the FileSystemObject...
'--
Function DriveStatus(drv As String) As Boolean
* *Dim fso As Object
* *Set fso = CreateObject("Scripting.FileSystemObject")
* *DriveStatus = fso.DriveExists(drv)
* *Set fso = Nothing
End Function
'--

So...
If DriveStatus("H") = True Then
* *'save file
Else
* 'chose another drive
End If
--
Jim Cone
Portland, Oregon *USA

"Paul"
wrote in message
Hi All,
I would really appreciate some help on this as my VB skills are not
good, I can often work with code from this group,but I am stuck on
this.

the code below will save a copy of a worksheet to the H Drive with a
file name with sheet name (paddock), cell reference and date time .xls
My problem is to check if H drive exists, then if it does not exist,
to prompt to SAVE As for user input to select another file on C drive
with the given file name.
appreciate any help on this.
here is the code.

Sub SaveASPaddock()
'This macro will SAVE AS to H:\ *folder, which must exist before macro
runs
* * ActiveSheet.Unprotect
* * Sheets("Paddock").Select
* * Range("A3").Select
* * Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
* * Selection.Copy
* * Workbooks.Add
* * Range("A1").Select
* * Selection.PasteSpecial Paste:=xlPasteValues
* * Selection.PasteSpecial Paste:=xlPasteFormats
* * Range("A1").Select
* * Application.CutCopyMode = False
* * ActiveWorkbook.SaveAsApplication.GetSaveAsFilename "H:\" &
"PaddockFee_" & Range("D1").Value & "_" & Format(Now, "yyyymmddhhmm")
& ".xls"
* * ActiveWorkbook.Close SaveChanges:=False
* * Sheets("Paddock").Select
* * Range("A3").Select
* * ActiveSheet.Protect UserInterfaceOnly:=True
End Sub

Thanks in advance
Cheers Paul