Create automatic save to USB drive tab on Excel 2007 document

Mayogroup
Mayogroup used Ask the Experts™
on
I have been asked to setup an Excel template so we can save it to a few thousand USB drives (one by one).

I have been asked to add a button on the sheet so it automatically saves to the USB drive.
Is this possible?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
It is certainly possible to add a button that starts a macro which saves the file to a chosen location, but when saving to an usb drive the problem is that you'll never know for sure what this location should be.

E.G. when you insert a USB drive, it will get the first available drive letter.

Author

Commented:
Assuming that it is only 1 pc who is using this.. How would you set it up?
you could use a strategy like :

 - find all known disc volumes
 - parse each volume for a specific name (the name given to the harddisk or usb drive, this is the name you see before (C:) (D:) etc in the windows explorer)
   or parse each volume for a specific file that exists in a specific folder (e.g. make sure that each usb drive has a file called "use_this_drive_for_excel_copying.txt")
 
or alternatively implement a 'listener' which listens to windows API calls to find out when a usb device has been plugged in. When such an usb drive has been found, automatically copy the file to it.
some examples :

To parse volumes and find out if they are removable (such as USB drives)
Sub find_disks()

strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk")

For Each objDisk In colDisks
    Debug.Print "DeviceID: " & objDisk.DeviceId
    Select Case objDisk.drivetype
        Case 1
            Debug.Print "No root directory. Drive type could not be determined."
        Case 2
            Debug.Print "DriveType: " & "Removable drive."
        Case 3
            Debug.Print "DriveType: " & "Local hard disk."
        Case 4
            Debug.Print "DriveType: " & "Network disk."
        Case 5
            Debug.Print "DriveType: " & "Compact disk."
        Case 6
            Debug.Print "DriveType: " & "RAM disk."
        Case Else
            Debug.Print "Drive type could not be determined (type " & objDisk.drivetype & ")."
    End Select
Next

End Sub

Open in new window


To parse all known USB disk drives
Sub usb_find_usb_drives()

    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set colDrives = objWMI.ExecQuery("Select * From Win32_DiskDrive Where InterfaceType = 'USB'")
    
    For Each objDrive In colDrives
        Set colPartitions = objDrive.Associators_(, "Win32_DiskPartition")
        For Each objPartition In colPartitions
            Set colDisks = objPartition.Associators_(, "Win32_LogicalDisk")
            For Each objDisk In colDisks
                Debug.Print "Device " & objDisk.DeviceId & " is a USB disk drive"
            Next
        Next
    Next
    
End Sub

Open in new window


to implement a listener (requires specific user rights)
Sub find_disk_by_volume_name()

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set colDrives = objFSO.Drives
    volume_name = "HomeFolder4"
    'cycle through all the drives to find the newly assigned lettter of the USB
    For Each objDrive In colDrives
        naam = objDrive.volumename
        If objDrive.volumename = volume_name Then
            Debug.Print "The volume [" & volume_name & "] is found on drive " & objDrive.driveletter
            End
        End If
    Next
    Debug.Print "The volume [" & volume_name & "] has not been found !"

End Sub

Sub asynchronous_listening_for_usd_drives()

    strComputer = "."
    Set objSink = WScript.CreateObject("WbemScripting.SWbemSink", "Sink_")
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    
    objWMI.ExecNotificationQueryAsync objSink, "Select * From __InstanceCreationEvent Within 1 Where TargetInstance Isa 'Win32_DiskDrive' And TargetInstance.InterfaceType = 'USB'"
    Debug.Print "Started monitoring USB drive creation"
    Do
        WScript.Sleep 1000
    Loop
    Debug.Print "Finished monitoring USB drive creation"

End Sub

Sub Sink_OnObjectReady(objEvent, objContext)
    
    Set colPartitions = objEvent.TargetInstance.Associators_(, "Win32_DiskPartition")
    
    For Each objPartition In colPartitions
        Set colDisks = objPartition.Associators_(, "Win32_LogicalDisk")
        For Each objDisk In colDisks
            Debug.Print "USB Monitoring : Device " & objDisk.DeviceId & " has just been plugged in"
            objSink.Cancel
            WScript.Quit
        Next
    Next


End Sub

Open in new window

Author

Commented:
Was able to record a macro and works fine.
Is it possible to link a button on the spreadsheet to use the macro?
Sure,

best is to follow the steps as indicated by

http://www.excel-vba-easy.com/vba-how-to-create-macro-excel.html

instead of the line

range("A1").value = "Hello"

Open in new window


you could use

find_disks

Open in new window


Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial