Add filenames to an array and pass it to a sorting function as a string argument

Question

The goal is to provide a folder choosing dialogue to read file names and paste them into the open Word document with the file names being the title (above the picture). This is to ease step by step documentations in Word with a style of "1. Do this", "2. Do that" .... "10. And then that", "11. And then this" (with it being sorted wrong, i.e. 1, 10, 11, 13, 2, 3, 4, 5, 6, 7, 8, 9 without the sorting function).

I can't overcome the type mismatch error, that the following VBA code generates (it seems to be the error of String vs. Array type):

Function:

Function QuickSortNaturalNum(strArray() As String, intBottom As Integer, intTop As Integer)
Dim strPivot As String, strTemp As String
Dim intBottomTemp As Integer, intTopTemp As Integer

    intBottomTemp = intBottom
    intTopTemp = intTop

    strPivot = strArray((intBottom + intTop) \ 2)

    Do While (intBottomTemp <= intTopTemp)
        ' < comparison of the values is a descending sort
        Do While (CompareNaturalNum(strArray(intBottomTemp), strPivot) < 0 And intBottomTemp < intTop)
            intBottomTemp = intBottomTemp + 1
        Loop
        Do While (CompareNaturalNum(strPivot, strArray(intTopTemp)) < 0 And intTopTemp > intBottom)
            intTopTemp = intTopTemp - 1
        Loop
        If intBottomTemp < intTopTemp Then
            strTemp = strArray(intBottomTemp)
            strArray(intBottomTemp) = strArray(intTopTemp)
            strArray(intTopTemp) = strTemp
        End If
        If intBottomTemp <= intTopTemp Then
            intBottomTemp = intBottomTemp + 1
            intTopTemp = intTopTemp - 1
        End If
    Loop

    'the function calls itself until everything is in good order
    If (intBottom < intTopTemp) Then QuickSortNaturalNum strArray, intBottom, intTopTemp
    If (intBottomTemp < intTop) Then QuickSortNaturalNum strArray, intBottomTemp, intTop
End Function

Sub:

Sub PicWithCaption()
    Dim xFileDialog As FileDialog
    Dim xPath, xFile, xFileNameOnly As String
    Dim xFileNameOnlySorted, xFileNameOnlyUnsorted As Variant
    Dim xFileNameOnlyUnsortedAsString As String
    Dim i, k, l As Integer
    
    l = 1
    m = 100
    
    On Error Resume Next
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    If xFileDialog.Show = -1 Then
        xPath = xFileDialog.SelectedItems.Item(i)
        If xPath <> "" Then
            xFile = Dir(xPath & "\*.*")
            For i = 0 To 100
                Do While xFile <> ""
                    xFileNameOnly = Left(xFile, Len(xFile) - 4)
                    xFileNameOnlyUnsorted(i) = xFileNameOnly
                    ReDim Preserve xFileNameOnlyUnsorted(0 To i) As Variant
                    xFileNameOnlyUnsorted(i) = xFileNameOnlyUnsorted(i).Value
                Loop
            Next i
            xFileNameOnlySorted = Module1.QuickSortNaturalNum(xFileNameOnlyUnsorted, l, m)
            For xFileNameOnlySorted(k) = 1 To 100
                If UCase(Right(xFileNameOnlySorted(k), 3)) = "PNG" Or _
                  UCase(Right(xFileNameOnlySorted(k), 3)) = "TIF" Or _
                  UCase(Right(xFileNameOnlySorted(k), 3)) = "JPG" Or _
                  UCase(Right(xFileNameOnlySorted(k), 3)) = "GIF" Or _
                  UCase(Right(xFileNameOnlySorted(k), 3)) = "BMP" Then
                    With Selection
                        .Text = xFileNameOnlySorted(k)
                        .MoveDown wdLine
                        .InlineShapes.AddPicture xPath & "\" & xFile, False, True
                        .InsertAfter vbCrLf
                        .MoveDown wdLine
                    End With
                End If
            Next xFileNameOnlySorted(k)
            xFile = Dir()
        End If
    End If
End Sub

Answer 1

Here's a slightly different approach:

Sub PicWithCaption()
    
    Dim xPath As String, colImages As Collection, arrFiles, f
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a folder with files to insert"
        .AllowMultiSelect = False
        If .Show = -1 Then xPath = .SelectedItems(1) & "\"
    End With
    If Len(xPath) = 0 Then Exit Sub
    
    Set colImages = ImageFiles(xPath) 'get a Collection of image file names
    
    If colImages.Count > 0 Then 'found some files ?
         arrFiles = CollectionToArray(colImages) 'get array from Collection
         SortSpecial arrFiles, "SortVal"         'sort files using `Val()`
         For Each f In arrFiles                  'loop the sorted array
            With Selection
                .Text = f
                .MoveDown wdLine
                .InlineShapes.AddPicture xPath & f, False, True
                .InsertAfter vbCrLf
                .MoveDown wdLine
            End With
         Next f
    Else
        MsgBox "No image files found in selected folder"
    End If

End Sub

'return a Collection of image files given a folder location
Function ImageFiles(srcFolder As String) As Collection
    Dim col As New Collection, f As String
    f = Dir(srcFolder & "*.*")
    Do While f <> ""
        Select Case UCase(Right(f, 3))
            Case "PNG", "TIF", "JPG", "GIF", "BMP"
                col.Add f
        End Select
        f = Dir()
    Loop
    Set ImageFiles = col
End Function

'create and return a string array from a Collection
Function CollectionToArray(col As Collection) As String()
    Dim arr() As String, i As Long
    ReDim arr(1 To col.Count)
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    CollectionToArray = arr
End Function

'Sorts an array using some specific translation defined in `func`
Sub SortSpecial(list, func As String)
    Dim First As Long, Last As Long, i As Long, j As Long, tmp, arrComp()
    First = LBound(list)
    Last = UBound(list)
    'fill the "compare array...
    ReDim arrComp(First To Last)
    For i = First To Last
        arrComp(i) = Application.Run(func, list(i))
    Next i
    'now sort by comparing on `arrComp` not `list`
    For i = First To Last - 1
        For j = i + 1 To Last
            If arrComp(i) > arrComp(j) Then
                tmp = arrComp(j)          'swap positions in the "comparison" array
                arrComp(j) = arrComp(i)
                arrComp(i) = tmp
                tmp = list(j)             '...and in the original array
                list(j) = list(i)
                list(i) = tmp
            End If
        Next j
    Next i
End Sub

'a function to allow comparing values based on the initial numeric part...
Function SortVal(v)
    SortVal = Val(v) ' "1 day" --> 1, "11 days" --> 11 etc
End Function