Save workbook To any USB Drive no matter what drive letter
 

Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

Try this user defined macro code assigned to a button and once it works for
you simply put your saving code in place of the msgbox code.

Sub Get_Drive_Info()
On Error Resume Next
Dim i As Integer

Set fs = CreateObject("Scripting.FileSystemObject")
For i = 67 To 90
Set drspec = fs.GetDrive(Chr(i))
If drspec.drivetype = 1 Then
MsgBox "Drive " & Chr(i) & " is the removable drive"
i = 90
End If
Next i
End Sub

"pano" wrote:

Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

The following link shows how to get the first CD-ROM drive, these have an ID
of 5; a removable drive is ID = 2 so change the code to suit.

http://support.microsoft.com/kb/q180766/


--

Regards,
Nigel




"pano" wrote in message
...
Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

Using Dennis's Code to get the Drive letter you can use this:

Open the Workbook using Alt+F11 and create a new Workbook_BeforeSave event
and paste the following into the Event SUB

Dim sPath As String
Dim sFilename As String
Dim i As Integer

Application.ScreenUpdating = False
On Error Resume Next

'Backup to Flashdrive
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 67 To 90
Set drspec = fs.GetDrive(Chr(i))
If drspec.drivetype = 1 Then

sPath = Chr(i) & ":\Backups\"
sFilename = "Personal Action Planner " & _
Format(DateSerial(Year(Date), Month(Date), _
Day(Date)), "dd MM yy") & ".xls"

ActiveWorkbook.SaveCopyAs sPath & sFilename

i = 90
End If
Next i

Application.ScreenUpdating = True

'Regards Dylan

"pano" wrote:

Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

Trouble is a Floppy is also considered as "removable". If fitted, assuming
the floppy is always A or B here is a simplified routine that checks "types"
of drive letters from D-Z. Of course there are other types of removable
drives besides floppy & USB.

Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const DRIVE_REMOVABLE As Long = 2
'Private Const DRIVE_FIXED = 3
'Private Const DRIVE_REMOTE = 4 ' eg network
'Private Const DRIVE_CDROM = 5
'Private Const DRIVE_RAMDISK = 6

Function Get1stRemovableAfterC(sDrive) As Boolean
Dim nDriveType As Long
Dim i As Long
For i = Asc("D") To Asc("Z")
sLetter = Chr(i) & ":\"
nDriveType = GetDriveType(sLetter)
If nDriveType = DRIVE_REMOVABLE Then
sDrive = sLetter
Get1stRemovableAfterC = True
Exit Function
End If
Next
End Function


Sub test()
Dim sDrive As String

If Get1stRemovableAfterC(sDrive) Then
MsgBox sDrive
Else
MsgBox "not found"
End If

End Sub

Regards,
Peter T



"Nigel" wrote in message
...
The following link shows how to get the first CD-ROM drive, these have an
ID
of 5; a removable drive is ID = 2 so change the code to suit.

http://support.microsoft.com/kb/q180766/


--

Regards,
Nigel




"pano" wrote in message
...
Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

Hi, this is the macro which I used before the security USB drives came
in which used to be always D drive for the USB key.
I have tried to incorporate it into the Macro Dennis gave to no avail.
Your code Denis does give me the MSG BOX up which knows that it is D
or E, but from their I'm lost
Any Help appreciated

Sub AASAVETOSTICK()
Application.DisplayAlerts = False
ChDir "D:\"
ActiveWorkbook.SaveAs Filename:="D:\July.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=True
Application.DisplayAlerts = True
End Sub

DENNIS MACRO

Sub Get_Drive_Info()
On Error Resume Next
Dim i As Integer


Set fs = CreateObject("Scripting.FileSystemObject")
For i = 67 To 90
Set drspec = fs.GetDrive(Chr(i))
If drspec.drivetype = 1 Then
MsgBox "Drive " & Chr(i) & " is the removable drive"
i = 90
End If
Next i
End Sub

Save workbook To any USB Drive no matter what drive letter
 

Peter

Good point! External CDwriters, digital cameras etc. are also classed as USB
Mass storage devices.

Dylan

"Peter T" wrote:

Trouble is a Floppy is also considered as "removable". If fitted, assuming
the floppy is always A or B here is a simplified routine that checks "types"
of drive letters from D-Z. Of course there are other types of removable
drives besides floppy & USB.

Private Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Const DRIVE_REMOVABLE As Long = 2
'Private Const DRIVE_FIXED = 3
'Private Const DRIVE_REMOTE = 4 ' eg network
'Private Const DRIVE_CDROM = 5
'Private Const DRIVE_RAMDISK = 6

Function Get1stRemovableAfterC(sDrive) As Boolean
Dim nDriveType As Long
Dim i As Long
For i = Asc("D") To Asc("Z")
sLetter = Chr(i) & ":\"
nDriveType = GetDriveType(sLetter)
If nDriveType = DRIVE_REMOVABLE Then
sDrive = sLetter
Get1stRemovableAfterC = True
Exit Function
End If
Next
End Function


Sub test()
Dim sDrive As String

If Get1stRemovableAfterC(sDrive) Then
MsgBox sDrive
Else
MsgBox "not found"
End If

End Sub

Regards,
Peter T



"Nigel" wrote in message
...
The following link shows how to get the first CD-ROM drive, these have an
ID
of 5; a removable drive is ID = 2 so change the code to suit.

http://support.microsoft.com/kb/q180766/


--

Regards,
Nigel




"pano" wrote in message
...
Hi all, I have tried the search and cannot get any of the other VBA
macros to work re this subject!!

I want to be able to press a button on a sheet on my workbook and have
a macro save the workbook to a USB drive which could come up as either
drive D - E or F. No prompts just save a copy.

Any help at all would be appreciated immensely as I dont have a clue
re VBA. I'm sure that someone must have code that works.

This is the last thing I need to complete the project.

Thanks in advance
Stephen

Save workbook To any USB Drive no matter what drive letter
 

Is anyone able to help with joing the code together so it works????

Thanks

Save workbook To any USB Drive no matter what drive letter
 

For all who have searched the archives and the net & found nothing
complete.
The following code works. Will save the excel file to personal.xls on
your USB drive no matter what letter drive it is.

Sub Save_to_usb_drive()
On Error Resume Next
Dim i As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 67 To 90
Set drspec = fs.GetDrive(Chr(i))
If drspec.drivetype = 1 Then

' MsgBox "Drive " & Chr(i) & " is the removable drive"
sPath = Chr(i) & ":\"
sFilename = "Personal.xls " & _
Format(DateSerial(Year(Date), Month(Date), _
Day(Date)), "dd MM yy") & ".xls"
ActiveWorkbook.SaveCopyAs sPath & sFilename
i = 90

End If
Next i
End Sub


Thanks members for all your help and suggestions.....

Save workbook To any USB Drive no matter what drive letter
 

Pano

It also adds the current date to the filename.

sFilename = "Personal.xls " & _
Format(DateSerial(Year(Date), Month(Date), _
Day(Date)), "dd MM yy") & ".xls"

Regards
Dylan

"pano" wrote:

For all who have searched the archives and the net & found nothing
complete.
The following code works. Will save the excel file to personal.xls on
your USB drive no matter what letter drive it is.

Sub Save_to_usb_drive()
On Error Resume Next
Dim i As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 67 To 90
Set drspec = fs.GetDrive(Chr(i))
If drspec.drivetype = 1 Then

' MsgBox "Drive " & Chr(i) & " is the removable drive"
sPath = Chr(i) & ":\"
sFilename = "Personal.xls " & _
Format(DateSerial(Year(Date), Month(Date), _
Day(Date)), "dd MM yy") & ".xls"
ActiveWorkbook.SaveCopyAs sPath & sFilename
i = 90

End If
Next i
End Sub


Thanks members for all your help and suggestions.....