pullmyefinger
Programmer
Runtime error 464; Object Required. Oops..
*** This is the Original Flashback Sub written to save a worksheet
to the hard drive and whatever USB drive is connected. I am now
getting a run-time error that says "Object Required" on the line
marked with asterisks.
Thank you again to strongM for writing and letting me use the
EjectByName Subroutine!
-------------------------------------------------------------------
' 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
*** This is the Original Flashback Sub written to save a worksheet
to the hard drive and whatever USB drive is connected. I am now
getting a run-time error that says "Object Required" on the line
marked with asterisks.
Thank you again to strongM for writing and letting me use the
EjectByName Subroutine!
-------------------------------------------------------------------
' 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