VBA程序仅获取文件资源管理器最后选中图片，求修改实现全选获取与复制

原代码仅能获取单个选中文件（焦点项），要获取所有选中文件，需改用SelectedItems集合遍历所有选中项，同时添加复制逻辑。以下是修改后的完整代码：

Sub CopyAllSelectedImages()
    ' 需添加两个引用：
    ' 1. Microsoft Internet Controls
    ' 2. Microsoft Shell Controls And Automation
    Dim expWindows As SHDocVw.ShellWindows
    Dim currWindow As SHDocVw.InternetExplorer
    Dim shellFolder As Shell32.Folder
    Dim selectedItem As Shell32.FolderItem
    Dim targetFolder As String
    
    ' 设置目标文件夹路径，请自行修改
    targetFolder = "C:\Your\Target\Folder\"
    
    ' 确保目标文件夹存在，不存在则创建
    If Dir(targetFolder, vbDirectory) = "" Then
        MkDir targetFolder
    End If
    
    Set expWindows = New SHDocVw.ShellWindows
    
    For Each currWindow In expWindows
        If Not currWindow.Document Is Nothing Then
            Set shellFolder = currWindow.Document
            ' 遍历所有选中的项目
            For Each selectedItem In shellFolder.SelectedItems
                ' 仅处理图片文件（可根据需要扩展后缀）
                Select Case LCase(Right(selectedItem.Path, 4))
                    Case ".jpg", ".jpeg", ".png", ".bmp", ".gif"
                        ' 复制文件到目标文件夹
                        FileCopy selectedItem.Path, targetFolder & selectedItem.Name
                        Debug.Print "已复制: " & selectedItem.Path
                End Select
            Next selectedItem
        End If
    Next currWindow
    
    Set selectedItem = Nothing
    Set shellFolder = Nothing
    Set currWindow = Nothing
    Set expWindows = Nothing
    
    MsgBox "选中图片复制完成！", vbInformation
End Sub

关键修改说明 #

• 替换FocusedItem为SelectedItems集合，遍历所有选中文件
• 添加目标文件夹检查与创建逻辑，避免复制失败
• 增加图片文件筛选，仅复制指定后缀的图片（可按需调整后缀列表）
• 加入复制完成提示，方便确认操作结果

引用添加步骤 #

1. 打开VBA编辑器（Alt+F11）
2. 点击菜单栏「工具」→「引用」
3. 在列表中勾选Microsoft Internet Controls和Microsoft Shell Controls And Automation
4. 点击「确定」完成引用添加

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