取消保存会取消激活链接 [英] Cancelled Save De-activates Links

问题描述

我将一个脚本放在一起，该脚本从给定路径的文件夹和子文件夹中提取文件列表.

I've put a script together which extracts a list of files from folders and subfolders from a given path.

• 在B列中，为找到的每个文件创建一个唯一的增量ID.此ID的格式为超链接.
• 当用户单击超链接时，它将打开一个对话框，允许用户选择要从服务器保存到本地存储驱动器的文件.

在此帖子 的帮助下，这是我正在使用的代码允许用户选择超链接并保存文件.

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:

运行时错误5无效的过程调用或参数"

'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.

推荐答案

如果用户取消了对话框，则运行时错误源于尝试访问fldr.SelectedItems(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

我没有做更多的调查，但是我怀疑由于Worksheet_FollowHyperlink事件中未处理的错误，超链接正在停用.您已在代码开始时关闭了所有事件处理，因此退出该事件时不会收到 任何 事件.我建议删除Application.EnableEvents = False代码，或者如果您必须取消设置标志或(更好)添加错误处理的事件:

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

这样，您可以确保永远不会遇到未打开.EnableEvents的情况.

That way you can ensure that you don't ever end up in a situation where .EnableEvents isn't turned back on.

这篇关于取消保存会取消激活链接的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！