如何通过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.GetOpenFileName使用Application.FileDialog，它可以为文件夹或文件等自定义。

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属性，如果真将让用户选择多个文件（不适用于文件夹）。然后，您可以循环播放.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 

Answer 2

而不是使用： -

Application.GetOpenFilename(Title:="Please select an evidence file to link to") 

甚至 -

Application.GetOpenFilename(Title:="Please select an evidence file to link to", MultiSelect:=True) 

以便他们可以选择多个文件，您可以根据需要将其添加为自己的订单项。

我会建议使用： -

Application.FileDialog msoFileDialogFolderPicker 

对于文件夹选择，并且： -

Application.FileDialog msoFileDialogFilePicker 

对于文件的选择，因为你没有错误，问题是： -

我想知道如果他们是一种方式来允许用户使链接连接到一个文件夹充满多个文件

以上信息应足以让您根据需要更改您的代码，我建议在您的UserForm，'链接文件'和'链接文件夹'上有两个按钮。

如果在更改代码时发生错误，请随时发布它们（如果找不到答案），并且我确信人们会帮助您完成特定的查询。