Part way figured out...

[pullmyefinger]

This code is intended to save a worksheet to the hard drive And
a flash drive no matter what the drive letters are.
It mainly goes by drive type and volume label but has stopped saving to the USB drive.

Skip V. mentioned to me that I should add Watch Variables to see what the values are
for the drive type and volume label.

I did that and the For..Each loops to choose drive (F with the volume label "64" and
that used to work fine with the drivetype=1(removeable/usb) and the vol label. It would
backup to the F: or whatever drive and eject the drive by the volume label.

NOW, It only works if I remove the drivetype=1 on the backup part but DOES NOT WORK
on the EjectByName("64") at all..
----------------------------------------------------------------------------------
Could it be something in Windows that I changed to cause this? Any ideas or suggestions
would be appreciated.
__________________________________________________________________________________





' Backup to Flash Drive, then back to the hard drive(s) for next Open

Dim Ans, fs, cvl, d, dc, drvltr, drvpath1, drvpath2, drvpath3, savedtoc

Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
savedtoc = 0


'fs=vb crap, cvl=current volume label, d&dc=vbcrap/for-each
'drvltr=text drive letter, drivepath*=paths for each bkp drive
'savedtoc is if you already saved to C: and another hard drive exists >C:,
'resave back to C: because of the order of the For-Each-Next (C,D,E,F,G,etc.)

Ans = MsgBox("Plug in Flash Drive & Click OK", vbOKOnly, "Flash Backup")
Application.DisplayAlerts = False 'DISABLES Alert Prompts (auto file overwrite)

'Paste Date backed up as Paste Special/VALUES

Worksheets("Archive").Select
Range("B4").Select
Selection.Copy
Worksheets("this month").Select
Range("G24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.ColorIndex = 14
Selection.Font.Size = 12

For Each d In dc
cvl = Dir(d.driveletter & ":", vbVolume)

If (d.DriveType = 1 And (cvl = "16" Or cvl = "32" Or cvl = "64")) Then 'Removable - Flash Drive

If d.IsReady Then
drvpath2 = d.driveletter & ":\XL\b.xls"
ActiveWorkbook.SaveAs (drvpath2)
Ans = MsgBox("saved to flash", vbOKOnly, drvpath2)
End If
End If

If (d.DriveType = 2 And cvl = "7") Then '2-Hard Disk

drvpath1 = d.driveletter & ":\Users\A\Documents\XL\b.xls"
ActiveWorkbook.SaveAs (drvpath1)
Ans = MsgBox("saved to Drive C:", vbOKOnly, "Save C:\..")
savedtoc = 1
End If
Next

If savedtoc = 1 Then
ActiveWorkbook.SaveAs (drvpath1)
End If

Application.DisplayAlerts = True 'Prompts Enabled

**** Run-time error 1004 occurs at the line below ****
**** "Object Required" is the message. I don't remember
**** changing anything in either routine.

If (d.DriveType = 1 And cvl = "16") Then
Call EjectByName("16")
End If
*******************************************************

If (d.DriveType = 1 And cvl = "32") Then 'Removable - Flash Drive
Call EjectByName("32")
End If

If (d.DriveType = 1 And cvl = "64") Then 'Removable - Flash Drive
Call EjectByName("64")
End If

Range("G8").Select

End Sub

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Static Sub EjectByName(strVolumeName As String)

'Donated to me by strongM from tek-tips.com

Dim fso As New FileSystemObject
Dim USBDrive As FolderItem2
Dim myShell As New Shell
Dim myDrive As Drive

For Each myDrive In fso.Drives

If myDrive.DriveType = 1 And myDrive.IsReady = True Then 'Removeable and Mounted

If myDrive.VolumeName = strVolumeName Then

Set USBDrive = myShell.Namespace(ssfDRIVES).ParseName(myDrive.Path)

USBDrive.InvokeVerb "Eject"

End If
End If
Next

End Sub


Any help would be appreciated. I do understand that the line with the error may not be
the problem. I don't remember changing any Configuration Settings either.
JR