Run time error 1004 in loop

[danpt]

Please help
Thanks

Sub Macro1()
' On each stick memory, I will have a book named as 'IDnumber.xls'
' I'm attempting to identify which drive that has 'IDtestnumber.xls'
' This script supposed to do that, but I kept getting 'Run-time error 1004'
' Memory stick keeps changing drive letter. Is there a way to identify them?
' If they have ID No., how do I find out the drive letter associated with
that ID No.?
Dim i As Long
Dim drive, driveletter As String
Application.ScreenUpdating = False
For i = 1 To 16
drive = Application.Choose(i, "E:", "F:", "G:", "H:", "I:", "J:")
On Error GoTo skip1
Workbooks.Open Filename:=drive & "\IDtestnumber.xls", UpdateLinks:=0
' If Error = Error(1004) Then GoTo skip1
Workbooks("IDtest.xls").Close SaveChanges:=False
GoTo skip2
skip1:
Next i
skip2:
driveletter = drive
End Sub

 

[Dave Peterson]

Option Explicit
Sub testme()
Dim FSO As Object
Dim myDrive As Object
Dim TestStr As String
Dim UseThisDrive As String
Dim myFileName As String

myFileName = "Idnumber.xls"

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each myDrive In FSO.drives
TestStr = ""
On Error Resume Next
'mydrive.path like C:\
TestStr = Dir(myDrive.Path & "\" & myFileName)
On Error GoTo 0
If TestStr = "" Then
'keep looking
Else
'mydrive.driveletter like C (no colon)
UseThisDrive = myDrive.driveletter
Exit For
End If
Next myDrive

If TestStr = "" Then
MsgBox myFileName & " not found!"
Else
MsgBox myFileName & " found on: " & UseThisDrive
End If

End Sub

If IDNumber.xls really means something like: ID1234.xls
then change this line:
myFileName = "Idnumber.xls"
to:
myFileName = "Id*.xls"

Dir() supports wildcards.

ps. There's a .drivetype that can be checked to see if the drive is removable:


Dim myType as string
.....
Select Case myDrive.DriveType
Case 0: mytype = "Unknown"
Case 1: mytype = "Removable"
Case 2: mytype = "Fixed"
Case 3: mytype = "Network"
Case 4: mytype = "CD-ROM"
Case 5: mytype = "RAM Disk"
End Select

So you could limit your code to just the removable drives:


For Each myDrive In FSO.drives
If myDrive.drivetype = 1 Then
'removable
TestStr = ""
On Error Resume Next
'mydrive.path like C:\
TestStr = Dir(myDrive.Path & "\" & myFileName)
On Error GoTo 0
If TestStr = "" Then
'keep looking
Else
'mydrive.driveletter like C (no colon)
UseThisDrive = myDrive.driveletter
Exit For
End If
End If
Next myDrive

 

[danpt]

Thank you, Dave
1 more question if you can
What is the significant differences between
On Error Resume Next and On Error GoTo skip

When I rewrote my script as follow, it worked.

Sub Macro1()
Dim i As Long
Dim drive, driveletter As String
Application.ScreenUpdating = False
For i = 1 To 9
drive = Application.Choose(i, "E:", "F:", "G:", "H:", "I:", "J:", "K:",
"L:", "M:")
On Error Resume Next
Workbooks.Open Filename:=drive & "\IDtestnumber.xls", UpdateLinks:=0
If Err.Number = 0 Then GoTo skip1
Next i
skip1:
Workbooks("IDtestnumber.xls").Close SaveChanges:=False
driveletter = drive
End Sub

 

[Dave Peterson]

On Error Resume Next
means that I know that the next line(s) may cause an error and I'll do the
checking in the same in order.

On Error goto skip1
means that the next next line(s) may cause an error and you want to branch to a
different location in the code.

 

[danpt]

Thanks again

On Error Resume Next
means that I know that the next line(s) may cause an error and I'll do the
checking in the same in order.

On Error goto skip1
means that the next next line(s) may cause an error and you want to branch to a
different location in the code.