问题
I've put a script together which extracts a list of files from folders and subfolders from a given path.
- In column B there is a unique, incremental ID created for each file found. This ID is formatted as a hyperlink.
- When the user clicks on the hyperlink, it opens a dialog box allowing the user to select the file to save from a server to a locally stored drive.
With help at this post, this is the code I'm using to allow the user to select the hyperlink and save the file.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim FSO
Dim sFile As String
Dim sDFolder As String
Dim thiswb As Workbook ', wb As Workbook
'Disable events so the user doesn't see the codes selection
Application.EnableEvents = False
'Define workbooks so we don't lose scope while selecting sFile(thisworkbook = workbook were the code is located).
Set thiswb = ThisWorkbook
'Set wb = ActiveWorkbook ' This line was commented out because we no longer need to cope with 2 excel workbooks open at the same time.
'Target.Range.Value is the selection of the Hyperlink Path. Due to the address of the Hyperlink being "" we just assign the value to a
'temporary variable which is not used so the Click on event is still triggers
temp = Target.Range.Value
'Activate the wb, and attribute the File.Path located 1 column left of the Hyperlink/ActiveCell
thiswb.Activate
sFile = Cells(ActiveCell.Row, ActiveCell.Column + 2).Value
'Declare a variable as a FileDialog Object
Dim fldr As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
'Allow only single selection on Folders
fldr.AllowMultiSelect = False
'Show Folder picker dialog box to user and wait for user action
fldr.Show
'Add the end slash of the path selected in the dialog box for the copy operation
sDFolder = fldr.SelectedItems(1) & "\"
'FSO System object to copy the file
Set FSO = CreateObject("Scripting.FileSystemObject")
' Copy File from (source = sFile), destination , (Overwrite True = replace file with the same name)
FSO.CopyFile (sFile), sDFolder, True
' Check if there's multiple excel workbooks open and close workbook that is not needed
' section commented out because the Hyperlinks no longer Open the selected file
' If Not thiswb.Name = wb.Name Then
' wb.Close
' End If
Application.EnableEvents = True
End Sub
The problem I have is that if the user selects a link, but instead of selecting a folder to save the file into and clicking 'OK', they select 'Cancel' when the user is taken back to the list every hyperlink then de-activated i.e the user cannot select any of these to save. If it helps, when they do select cancel they receive the following error:
'Run time error 5 Invalid procedure call or argument'
I've done some research on this and know that I can reset the hyperlinks, but from what I understand this seems to be more about the colour of the link unless I've misunderstood.
I just wondered whether someone may be able to look at this please and offer some guidance on how I may overcome this.
回答1:
The run time error stems from trying to access fldr.SelectedItems(1)
if the user cancelled the dialog. All you should need to do is check to see if you got a folder back:
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.AllowMultiSelect = False
fldr.Show
'Did the user cancel?
If fldr.SelectedItems.Count > 0 Then
sDFolder = fldr.SelectedItems(1) & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile (sFile), sDFolder, True
Else
'Do anything you need to do if you didn't get a filename.
End If
I haven't investigated much further than that, but I suspect that the hyperlinks are deactivating because of the unhandled error in the Worksheet_FollowHyperlink
event. You've turned off all of the event handling at the start of the code, so when it exits you don't get any events. I'd suggested either removing the Application.EnableEvents = False
code, or if there are events that you have to suppress either set a flag or (better) add error handling:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error GoTo CleanExit:
Application.EnableEvents = False
'...
CleanExit:
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End If
Application.EnableEvents = True
End Sub
That way you can ensure that you don't ever end up in a situation where .EnableEvents
isn't turned back on.
来源:https://stackoverflow.com/questions/29878297/cancelled-save-de-activates-links