check if drive exists - if not prompt to SAVE AS box

P

Paul

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
 
J

Jim Cone

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top