vba - 如何在Excel中通过vba表单链接文件

Question

我创建了一个表单，允许用户单击按钮，然后它允许您浏览和查找文档或其他内容，并将其作为与其他相关数据的链接提交。我想知道他们是否是一种允许用户使链接连接到充满多个文件的文件夹的方法，而无需他们手动执行。下面是我的代码

  Private Sub AddPicture_Click()
Dim strFileToLink As String

'link name
lnkNm = InputBox("please enter link description")
Application.ScreenUpdating = False
strFileToLink = Application.GetOpenFilename _
(Title:="Please select an Evidence file to link to")

'Checking if file is selected.
If strFileToLink = "" Then
    'Displaying a message if file not choosen in the above step.
    MsgBox "No file selected.", vbExclamation, "Sorry"
    'And exiting from the procedure.
    Exit Sub
Else
    'print link to sheet as a hyperlink.
    erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    With ActiveSheet

        If ActiveSheet.Index >= 5 Then
            .Hyperlinks.Add Anchor:=Cells(erow, 12), _
            Address:=strFileToLink, _
            ScreenTip:="Picture Link", _
            TextToDisplay:=lnkNm

        Else
            .Hyperlinks.Add Anchor:=Cells(erow, 13), _
            Address:=strFileToLink, _
            ScreenTip:="Picture Link", _
            TextToDisplay:=lnkNm

        End If
    End With
  End If
End Sub

有关改进代码的评论也将不胜感激。谢谢你

Answer 1

使用 Application.FileDialog 代替 Application.GetOpenFileName，它可以针对文件夹或文件等进行自定义。

https://msdn.microsoft.com/en-us/library/office/ff836226.aspx

以下是如何使用它来获取文件夹名称或文件名:

Dim fdlg As FileDialog

Dim fdlgType as Long, itm as Variant
fdlgType = Application.InputBox("Enter '3' to choose a FILE, or '4' to choose a FOLDER")
If fdlgType < 3 or fdlgType > 4 Then Exit Sub
Set fdlg = Application.FileDialog(fdlgType)
With fdlg
    .Title = IIf(fdlgType = 3, "Please select an Evidence FILE to link to", _
                               "Please select an Evidence FOLDER to link to")
    .ButtonName = IIf(fdlgType = 3, "Select File", "Select Folder")
    .Show
    For Each itm in .SelectedItems
        MsgBox itm
    Next
End With

FileDialog 有一个 .AllowMultiSelect 属性，如果为 True，将允许用户选择多个文件(不适用于文件夹)。然后您可以循环 .SelectedItems。

在您的代码中，For Each itm 循环将包含添加超链接的代码:

If .SelectedItems.Count = 0 Then
    MsgBox "Nothing selected.", vbExclamation, "Sorry"
    Exit Sub
End If
For Each itm in .SelectedItems
    'print link to sheet as a hyperlink.
    With ActiveSheet
        erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        If .Index >= 5 Then
            .Hyperlinks.Add Anchor:=.Cells(erow, 12), _
            Address:=itm, _
            ScreenTip:="Picture Link", _
            TextToDisplay:=lnkNm

        Else
            .Hyperlinks.Add Anchor:=.Cells(erow, 13), _
            Address:=itm, _
            ScreenTip:="Picture Link", _
            TextToDisplay:=lnkNm

        End If
    End With
Next