如何用vba遍历文件夹中的文件并创建超链接?

在前面的文章中,分别介绍了如何在VBA中创建超链接如何用FSO对象操作文件和文件夹

今天结合以上两个教程,介绍如何用vba遍历文件夹中的文件并在单元格中创建文件的超链接的方法。

以下代码将提取任意路径下的所有文件并在活动工作表的A列创建所有文件的超链接

Sub QQ1722187970()
    Dim i
    Dim sPath
    sPath = GetPath
    If Len(sPath) Then
    Dim oWK As Worksheet
    Set oWK = ActiveSheet
    oWK.Cells.Clear
    '定义一个FileSystemObject对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义一个文件夹对象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            '在活动单元格的A列创建对文件夹中的所有文件的超链接
            With oWK
                .Hyperlinks.Add anchor:=.Cells(1 + i, 1), Address:=oFile.Path, TextToDisplay:=oFile.Name
            End With
            i = i + 1
        Next
    End If
    Else
    MsgBox "你没有选择文件夹"
    End If
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
    Dim oFDFilter As FileDialogFilters
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名
    Dim vrtSelectedItem As Variant
    With oFD
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框,如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function

 

 

       

发表评论