批量插入图像作为文件对象

我创建了以下 VBA 代码，它可以满足我的需求：

Public lastPath As String

Sub InsertFolderContents()
    ' This mode is used to pick a folder and have all files inserted
    Dim counter_filesInserted As Integer
    counter_filesInserted = 1 ' Even though no files have been inserted yet, it's easier to not have to think in 0-based indexes

    Dim fileExplorer As FileDialog
    Dim folder_Path As String

    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
    With fileExplorer
        .InitialFileName = lastPath

        If .Show = -1 Then ' ".Show" actually causes the dialogue to open
            folder_Path = .SelectedItems.Item(1) & Application.PathSeparator ' "Application.PathSeparator" is required to be appended otherwise the later concatenated path is invalid
            lastPath = folder_Path
        Else
            folder_Path = "NONE"
        End If
    End With

    Dim Files As String
    Files = Dir(folder_Path)

    ' For some reason, calling InsertFiles from within Do While completely breaks "Files = Dir" so need to build array of files THEN loop through them to call InsertFiles

    Dim counter_fileList As Integer

    Dim DirectoryListArray() As String
    ReDim DirectoryListArray(1000)

    Do While Files <> ""
        DirectoryListArray(counter_fileList) = Files
        Files = Dir
        counter_fileList = counter_fileList + 1
    Loop

    ReDim Preserve DirectoryListArray(counter_fileList - 1)

    For counter_fileList = 0 To UBound(DirectoryListArray)
        Dim file_Name_Original As String
        file_Name_Original = DirectoryListArray(counter_fileList)
        Dim file_Path As String
        file_Path = folder_Path & file_Name_Original

        InsertFiles file_Path, counter_filesInserted
    Next counter_fileList
End Sub


Sub InsertMultipleFiles()
    ' This mode is used to pick specific files to have inserted

    Dim counter_filesInserted As Integer
    counter_filesInserted = 1 ' Even though no files have been inserted yet, it's easier to not have to think in 0-based indexes

    Dim fileExplorer As FileDialog
    Dim folder_Path As String

    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
    With fileExplorer
        .InitialFileName = lastPath
        .AllowMultiSelect = True

        If .Show = -1 Then ' ".Show" actually causes the dialogue to open
            folder_Path = Left(.SelectedItems.Item(1), InStrRev(.SelectedItems.Item(1), "\"))
            lastPath = folder_Path
        Else
            folder_Path = "NONE"
        End If

        Dim file_Path As Variant
        For Each file_Path In .SelectedItems
            InsertFiles file_Path, counter_filesInserted
        Next
    End With
End Sub

Function InsertFiles(file_Path, counter_filesInserted)
    Dim file_Name_Original As String
    Dim file_Ext As String
    Dim file_Inserted As Boolean
    Dim regex As Object

    file_Name_Original = Dir(file_Path)

    file_Ext = Right(file_Path, Len(file_Path) - InStrRev(file_Path, "."))

    file_Inserted = False

    ' My report standalone files are named "<section number> <section title> - " so this regex strips those out for readability but doesn't affect files that aren't named that way
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\d{1,2}.\d{1,2}(.\d{1,2})?[\w\s]+ - "
    regex.IgnoreCase = True
    regex.Global = True
    file_Name_Shortened = regex.Replace(file_Name_Original, "")

    ' The IconIndex number is literally just what number icon is inside that file -1 (as it's a 0-based index). An easy way to determine this is to use Word's "Change icon" function.

    If file_Ext = "png" Or file_Ext = "jpg" Then
        Selection.InlineShapes.AddOLEObject _
        FileName:=file_Path, _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Program Files (x86)\Internet Explorer\iexplore.exe", _
        IconIndex:=13, _
        IconLabel:=file_Name_Shortened

        file_Inserted = True
    ElseIf file_Ext = "html" Then
        Selection.InlineShapes.AddOLEObject _
        FileName:=file_Path, _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Program Files (x86)\Internet Explorer\iexplore.exe", _
        IconIndex:=1, _
        IconLabel:=file_Name_Shortened

        file_Inserted = True
    ElseIf file_Ext = "pdf" Then
        Selection.InlineShapes.AddOLEObject _
        FileName:=file_Path, _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Windows\Installer\{AC76BA86-7AD7-1033-7B44-AC0F074E4100}\PDFFile_8.ico", _
        IconIndex:=1, _
        IconLabel:=file_Name_Shortened

        file_Inserted = True
    ElseIf file_Ext = "csv" Or file_Ext Like "xls*" Then
        Selection.InlineShapes.AddOLEObject _
        FileName:=file_Path, _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Windows\Installer\{90160000-000F-0000-0000-0000000FF1CE}\xlicons.exe", _
        IconIndex:=1, _
        IconLabel:=file_Name_Shortened

        file_Inserted = True
    ElseIf file_Ext Like "doc*" Then
        Selection.InlineShapes.AddOLEObject _
        FileName:=file_Path, _
        LinkToFile:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Windows\Installer\{90160000-000F-0000-0000-0000000FF1CE}\wordicon.exe", _
        IconIndex:=13, _
        IconLabel:=file_Name_Shortened

        file_Inserted = True
    End If

    If file_Inserted = True Then
        ' Inserted file objects look untidy without a tab for space between them but you have to not do this every 4th otherwise it looks weird.
        If (counter_filesInserted Mod 4) <> 0 Or counter_filesInserted = 0 Then
                Selection.TypeText Text:=vbTab
        End If

        counter_filesInserted = counter_filesInserted + 1
    End If
End Function

这样做的一个很好的副作用是文件按字母顺序排序，而如果您使用常规方法批量导入，则文件不是按字母顺序排列的。