I see the obvious code errors, especially the error where your code breaks. See comments between lines of your code:
'---------------------------------------------------------------------------------------
' Module : Module_get_hyperlink_cut_sheets
' DateTime : 5/01/2009 13:21
' Author : Mark
' Purpose : The Program will sort through the current drawings model space blocks
' : and find any associated hyperlinks to a PDF Cut Sheet and move that cut
' : sheet to the PATH v:\Current_Project\Cut Sheets\ Directory.
'---------------------------------------------------------------------------------------
Option Explicit
Public Sub Gartner_Get_Hyperlink_Main()
Dim objBlock As AcadBlockReference
Dim objEnt As AcadEntity
Dim colHyps As AcadHyperlinks
Dim fso As FileSystemObject
Set fso = New FileSystemObject
''Following "If...Then...End If" does not do what you intended (to delete all PDF file in a folder)
''The reason is you did not pass a valid file name to fso.DeleteFile() method: there is no file that can be
''named as "*.pdf". fso.DeleteFile() only delete one file at a time. It does not delete all files by accepting
''a wildcard file name pattern like *.pdf. You need to use repeatedly call Dir(path & "\*.pdf") to obtain each
''PDF file name and delete it one by one.
If Len(Dir(ThisDrawing.Path & "\Cut Sheets\*.pdf")) <> 0 Then
' Checks to see if there are any PDFs in CURRENT_Project\Cut Sheets\
fso.DeleteFile ThisDrawing.Path & "\Cut Sheets\*.pdf", True
' If there are, delete them
End If
For Each objEnt In ThisDrawing.ModelSpace
If TypeOf objEnt Is AcadBlockReference Then
Set objBlock = objEnt
Set colHyps = objBlock.Hyperlinks
''This is typical worng use of "On Error Resume", which hide the error from you
''Since you did not make sure in code that you would definitely get an valid file name
''from the hyperlink's Url. Since the fso.Copy file could fail (and it did), you should handle
''possible error
On Error Resume Next
' In case we encounter any blocks that DON'T have hyperlinks
''Assume you did get a valid file name froom the Url (you may add "Debug.Print colHyps.Item(0).URL"
''To verify you do have a good file name always) here, the second parameter passed to fso.FileCopy()
''method is definitely wrong: you cannot name the destination file as *.pdf. That is "*" is not allowed in
"file name. I guess what you really want to do is to just make a copy of the source file into the
''...\Cut Sheets\" folder with the same file name. So, you have to parse out the file name from the
''URL string and use it as destination file name with new folder path
fso.CopyFile colHyps.Item(0).URL, ThisDrawing.Path & "\Cut Sheets\*.pdf", True
' The TRUE option will automatically overwrite any existing files with the same name
End If
Next objEnt
Set fso = Nothing
End Sub
Another issue: it is strongly recommended you donot use FileSystemObject from MS Scripting Runtime. For simple file copy/delete, VB/A has built-in methods: FileCopy() and Kill(). Addiing unnecessary dependncy to your program is bad thing to do, not to mention there are different version of Scripting runtimes, depending on Windows OS versions, which may cause trouble to your program, especially the trouble is really easily avoidable.
