Question

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

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

使用帮助at this发布，这是我用来允许用户选择超链接并保存文件的代码。

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

我遇到的问题是，如果用户选择了一个链接，而不是选择一个文件夹来保存文件并单击“确定”，那么当用户每个超链接被带回列表时，他们会选择“取消”去激活即用户无法选择任何这些来保存。如果有帮助，当他们选择取消时会收到以下错误：

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

我已经对此做过一些研究，并且知道我可以重置超链接，但据我所知，除非我误解，否则这似乎更多是关于链接的颜色。

我只是想知道某人是否能够看到这个并提供一些指导我如何克服这个问题。

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事件中未处理的错误，超链接正在停用。您已在代码开头关闭了所有事件处理，因此当它退出时，您不会任何事件。我建议删除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没有重新开启的情况下不会结束。

取消保存取消激活链接

1 个答案: