如何修改VBA代码实现多文件选择并批量生成带权限的邮件超链接？

核心改动说明 #

• 将文件选择器的.AllowMultiSelect设为True，启用多文件选择
• 新增循环遍历所有选中文件，逐个完成只读权限配置
• 集成Outlook邮件创建逻辑，批量插入每个文件的超链接至正文

Sub CreateMultiFileHyperLinks()
    Dim fd As Object, objShell As Object, FSO As Object
    Dim permissionCommand As String
    Dim selectedItem As Variant
    Dim olApp As Object, olMail As Object
    Dim fPath As String, fName As String
    
    ' 初始化各类对象
    Set objShell = CreateObject("Wscript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0) ' 创建新邮件
    
    permissionCommand = " /grant Everyone:(r)"
    
    With fd
        .InitialFileName = "standard directory etc."     
        .InitialView = msoFileDialogViewDetails
        .AllowMultiSelect = True ' 开启多选功能
        .Title = "请选择需要处理的文件"
        .Filters.Clear
        .Filters.Add "视频文件", "*.cva,*.mp4,*.webm"
        .Filters.Add "所有文件", "*.*"
        
        If .Show = True Then
            ' 初始化邮件正文开头
            olMail.Body = "以下是已设置只读权限的文件链接：" & vbCrLf & vbCrLf
            
            ' 循环处理每个选中文件
            For Each selectedItem In .SelectedItems
                fPath = selectedItem
                fName = Right(fPath, Len(fPath) - InStrRev(fPath, "\"))
                
                ' 为文件配置Everyone只读权限
                If FSO.FileExists(fPath) Then
                    ' 用三重引号包裹路径，避免空格导致命令执行失败；后台运行并等待完成
                    objShell.Run "cmd /c icacls.exe """ & fPath & """" & permissionCommand, 0, True
                End If
                
                ' 将文件转为可识别的超链接格式，插入邮件HTML正文
                olMail.HtmlBody = olMail.HtmlBody & _
                    "<a href='file:///" & Replace(fPath, "\", "/") & "'>" & fName & "</a><br>"
            Next selectedItem
            
            ' 弹出邮件编辑窗口
            olMail.Display
        Else
            Exit Sub
        End If
    End With
    
    ' 释放对象，避免内存占用
    Set fd = Nothing
    Set objShell = Nothing
    Set FSO = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

细节补充 #

1. 权限命令优化：用三重引号包裹文件路径，解决含空格路径的命令执行报错问题；0, True参数让cmd窗口后台静默运行，并等待权限配置完成后再继续执行
2. 超链接格式处理：将Windows路径的反斜杠替换为正斜杠，添加file:///前缀，确保邮件中的超链接能直接打开对应文件
3. 对象释放：代码末尾手动释放所有创建的对象，避免VBA进程残留内存占用

内容的提问来源于stack exchange，提问作者Christopher