取消保存停用链接

Question

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

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

在 post 的帮助下，这是我用来允许用户 select hyperlink 并保存文件的代码。

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

我遇到的问题是，如果用户 select 是 link，而不是 select 将文件保存到文件夹并单击 'OK'，他们 select 'Cancel' 当用户被带回列表时，每个 hyperlink 然后被停用，即用户无法 select 保存其中任何一个。如果有帮助，当他们 select 取消时，他们会收到以下错误：

'Run time error 5 Invalid procedure call or argument'

我对此做了一些研究，知道我可以重置 hyperlinks，但据我了解，这似乎与 link 的颜色有关，除非我误会了。

我只是想知道是否有人可以查看此内容并就如何克服此问题提供一些指导。

Answer 1

运行时间错误源于在用户取消对话框时尝试访问 fldr.SelectedItems(1)。您需要做的就是检查您是否找回了文件夹：

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 事件中未处理的错误而停用。您在代码开头关闭了所有事件处理，因此当它退出时您不会获得 any 事件。我建议要么删除 Application.EnableEvents = False 代码，要么如果有你必须抑制的事件，要么设置一个标志，要么（更好）添加错误处理：

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 未重新开启的情况。

取消保存停用链接

Cancelled Save De-activates Links

excel

vba

excel-2013