Option Explicit
_____________________________________________________________________________________


Function UniqueImageNames(ByVal Path As String, Optional ByVal Filter As String, Optional Ext As Variant, Optional KeepTNflag As Boolean, Optional StripToBare As Boolean, Optional LooseFlag As Boolean) As Collection
' returns collection. use Collection2Array function if Array wanted
' default is exact match. flag allows simply to be successful string search
' StripToBare overrides Filter

    Dim bool As Boolean, NumInFilter As Boolean
    Dim LenExt As Integer
    Dim fn As String
    Dim FileList As New Collection
    Dim f, fls As Variant

    If IsMissing(Ext) Then Ext = ".jpg"
    If Left(Ext, 1) <> "." Then
        Ext = "." & Ext
    End If
    LenExt = Len(Ext)

' is ending number in the filter? -> this is n.g. when there is a dash in the file name
    NumInFilter = InStr("0123456789", Right(Filter, 1)) <> 0 And Left(Right(Filter, 2), 1) = "-"
    NumInFilter = NumInFilter Or InStr("0123456789", Right(Filter, 1)) <> 0 And InStr("0123456789", Left(Right(Filter, 2), 1)) <> 0 And Left(Right(Filter, 3), 1) = "-"

    Set fls = CreateObject("Scripting.FileSystemObject").GetFolder(Path).Files
    For Each f In fls
        If Right(f, LenExt) = Ext Then
' remove file extension (.jpeg extension is not allowed)
            f = DropStr(f, -LenExt)
' blank out master images
            If Right(f, 2) = "-f" Then
                f = DropStr(f, -2)
            ElseIf Right(f, 3) = "-ff" Then
                f = DropStr(f, -3)
            End If
' check for filter
            If 0 <> Len(Filter) Or StripToBare Then
                fn = ExtractFilename(f)
' strip off number, but not if number is in the filter
                If StripToBare Or Not NumInFilter Then
                    If InStr("0123456789", Right(fn, 1)) <> 0 And Left(Right(fn, 2), 1) = "-" Then
                        fn = DropStr(fn, -2)
                    ElseIf InStr("0123456789", Right(fn, 1)) <> 0 And InStr("0123456789", Left(Right(fn, 2), 1)) <> 0 And Left(Right(fn, 3), 1) = "-" Then
                        fn = DropStr(fn, -3)
                    End If
                End If
' then test
                If StripToBare Then
                    If Right(fn, 3) = "-tn" Then
                        fn = DropStr(fn, -3)
                    End If
                    On Error Resume Next
                    FileList.Add fn, fn
                    On Error GoTo 0
                    GoTo NextLoop
                End If
' we have a tight and a loose way of selecting
                If LooseFlag Then
                    bool = InStr(fn, Filter) = 0
                Else
                    bool = Filter <> fn
                End If
                If bool Then
                    GoTo NextLoop
                End If
            End If
' remove thumbnails
            If KeepTNflag Then
                If Right(f, 3) = "-tn" Then
                    On Error Resume Next
                    FileList.Add f, f
                    On Error GoTo 0
                End If
            ElseIf Right(f, 3) <> "-tn" Then
                On Error Resume Next
                FileList.Add f, f
                On Error GoTo 0
            End If
        End If
NextLoop:
    Next f
' return collection
    Set UniqueImageNames = FileList

End Function
_____________________________________________________________________________________


Function ReturnImageLink(ByVal Path As String, ByVal EntryType As String, Optional ByVal Filter As String, Optional ByVal Prefix As String) As String
' arg: 1-Path, 2-EntryType, 3-Filter, 4-Prefix
' Entryes supported:
' 0 - nothing. Default.
' 1 - surround with <div class="cell">xx</div>
' 9 - add <br> to end

    Dim AltString As String, File As String, H As String
    Dim SizeFS As Variant

' create filename
    File = Path & "\" & Filter
' clean up name to use as alt string
    AltString = Replace(Filter, "-", " ")
' check for full-size image existence
    If FileExists(File & "-f.jpg") Then
        SizeFS = GetImageSize(File & "-f.jpg")
' build image string
        H = "<a href=""" & Prefix & ExtractFilename(File) & "-f.jpg""><img src=""" & Prefix & ExtractFilename(File) & ".jpg"" alt=""" & AltString & """ title=""Click image for full-size image (" & SizeFS(0) & " &times; " & SizeFS(1) & " pixels).""></a>"
    Else
        H = "<img src=""" & Prefix & ExtractFilename(File) & ".jpg"" alt=""" & AltString & """>"
    End If
' return
    If EntryType = 1 Then
        H = "<div class=""cell"">" & H & "</div>"
    ElseIf EntryType = 9 Then
        H = H & vbCrLf & "<br>"
    End If
    ReturnImageLink = H & vbCrLf

End Function
_____________________________________________________________________________________


Function CreateImageLinks(ByVal Path As String, ByVal EntryType As String, Optional ByVal Filter As String, Optional ByVal Prefix As String, Optional WidePicFlag As Boolean, Optional Ext As Variant, Optional ByVal KeepTNflag As Boolean, Optional LooseFlag As Boolean) As String
' EntryType:
' 0 - interlace with <p>'s. Default.
' 1 - surround with <div class="cell">xx</div>
' 2 - same as 1, but has leading <br> with expectation title will be added to each cell
' 3 - surround with <td>xx</td>
' 4 - surround with <span class="floatLeft">xx</span>
' 5 - surround with <span class="floatLeft"><a href=".htm">xx</a></span>
' 6 - surround with <span class="floatRight">xx</span>
' 7 - surround with <span class="floatRight"><a href=".htm">xx</a></span>
' 8 - surround with <p> and <hr>
' 9 - interlace with <br>'s
' 10 - javascript slide show (all found will be in slide show) -> all must be same size
' 11 - cell container for thumbnails

    Dim FileList As Collection
    Dim i As Integer
    Dim H As String, k As Integer, StrRes As String, W As String
    Dim File, Size As Variant

    If IsMissing(Ext) Then Ext = ".jpg"

StartAgain:
    Set FileList = UniqueImageNames(Path, Filter, Ext, KeepTNflag, , LooseFlag)

    If FileList.Count = 0 And Ext = ".jpg" Then
        Ext = ".webp"
        GoTo StartAgain
    End If

' maybe they put in a bad path?
    If FileList.Count = 0 Then
        Application.StatusBar = False
        If 0 <> Len(Filter) Then
            W = ", or filter is too tight for " & Filter
        Else
            W = ""
        End If
        MsgBox "No " & Ext & " files found to process" & W & ". Check path. Aborting.", vbCritical, "No Files!"
        CreateImageLinks = ""
        End
    End If

    If EntryType = 10 Then
        Size = GetImageSize(FileList(1) & Ext)
' this can be replaced by WorksheetFunction.SpellNumber() in newer version
' StrConv(strText, vbProperCase)
        StrRes = "<div class=""subtitle"">" & FileList.Count & " Page Article</div>" & vbCrLf & vbCrLf
        StrRes = StrRes & "<div class=""slideshow-container"" style=""max-width:" & Size(0) & "px;"">" & vbCrLf & vbCrLf
        i = 1
TryAgain:
        k = InputBox("Suffix for Slide Show (1 or 2):", "Suffix Needed", "1")
        If k <> 1 And k <> 2 Then
            MsgBox "Can only enter a 1 or 2.", vbCritical, "Try Again"
            GoTo TryAgain
        End If
    Else
        StrRes = ""
    End If

    For Each File In FileList
        H = ImageString(File, Prefix, Ext, WidePicFlag)
' add container around it
        If EntryType = 0 Then
            StrRes = StrRes & H & vbCrLf

        ElseIf EntryType = 1 Then
            StrRes = StrRes & "<div class=""cell"">" & H & "</div>" & vbCrLf
        ElseIf EntryType = 2 Then
            StrRes = StrRes & "<div class=""cell"">" & vbCrLf
            StrRes = StrRes & "<br>" & H & "</div>" & vbCrLf

        ElseIf EntryType = 3 Then
            StrRes = StrRes = "<td>" & H & "</td>" & vbCrLf

        ElseIf EntryType = 4 Then
            StrRes = StrRes & "<span class=""floatLeft"">" & H & "</span>" & vbCrLf
        ElseIf EntryType = 6 Then
            StrRes = StrRes & "<span class=""floatRight"">" & H & "</span>" & vbCrLf

        ElseIf EntryType = 5 Then
            StrRes = StrRes & "<span class=""floatLeft""><a href="".htm"">" & H & "</a></span>" & vbCrLf
        ElseIf EntryType = 7 Then
            StrRes = StrRes & "<span class=""floatRight""><a href="".htm"">" & H & "</a></span>" & vbCrLf

        ElseIf EntryType = 8 Then
            StrRes = StrRes & "<p>" & vbCrLf
            StrRes = StrRes & H & vbCrLf
            StrRes = StrRes & "<hr>" & vbCrLf

        ElseIf EntryType = 9 Then
            StrRes = StrRes & H & vbCrLf & "<br>" & vbCrLf

        ElseIf EntryType = 10 Then
            StrRes = StrRes & "<div class=""mySlides" & k & """>" & vbCrLf
            StrRes = StrRes & "<div class=""numbertext"">" & i & " / " & FileList.Count & "</div>" & vbCrLf
            StrRes = StrRes & H & vbCrLf
            StrRes = StrRes & "</div>" & vbCrLf
            i = i + 1

        ElseIf EntryType = 11 Then
            W = ExtractFilename(File)
            StrRes = StrRes & "<div class=""cell"" id=""" & W & """>" & vbCrLf
            StrRes = StrRes & "<a href=""" & W & ".htm"">" & StrConv(Replace(Replace(W, "-", " "), "+", " and "), vbProperCase) & vbCrLf
            StrRes = StrRes & "<br><img src=""" & Prefix & W & "-tn.jpg"""
            StrRes = StrRes & " alt=""" & (Replace(W, "-", " ")) & """></a></div>" & vbCrLf
        End If

        If EntryType = 0 Then
            StrRes = StrRes & "<p>"
        End If
        StrRes = StrRes & vbCrLf
    Next File

    If EntryType = 10 Then
        StrRes = StrRes & "<a class=""prev"" onclick=""plusSlides(-1," & k - 1 & ")"">&#10094;</a>" & vbCrLf
        StrRes = StrRes & "<a class=""next"" onclick=""plusSlides(1," & k - 1 & ")"">&#10095;</a>" & vbCrLf
        StrRes = StrRes & "</div>" & vbCrLf
    Else
' remove any stray at the end
        If Right(StrRes, 5) = "<p>" & vbCrLf Then
            StrRes = DropStr(StrRes, -5)
        End If
    End If

    CreateImageLinks = StrRes

End Function
_____________________________________________________________________________________


Function ImageString(File As Variant, Prefix As String, ByVal Ext As String, WidePicFlag As Boolean) As String

    Dim AltString As String, W As String
    Dim Size, SizeFS As Variant

' clean up name to use as alt string
        AltString = ExtractFilename(File)
        If 0 <> InStr(AltString, "_") Then
            AltString = Left(AltString, InStr(AltString, "_") - 1)
        End If
        AltString = Replace(AltString, "-", " ")
' sometimes add class to not have max-width to be 100%
        W = ""
        If WidePicFlag Then
' we normally allow processing without the web-size image needing to be present, but not for this
            If FileExists(File & Ext) Then
                Size = GetImageSize(File & Ext)
                If 1200 < Size(0) Then
                    W = " class=""widepic"""
                End If
            Else
                MsgBox "When running with WidePic option you need the web-size image to also be present.", vbCritical, "Missing File"
                End
            End If
        End If
' check for full-size image existence
        If FileExists(File & "-f" & Ext) Then
            SizeFS = GetImageSize(File & "-f" & Ext)
' build image string
            ImageString = "<a href=""" & Prefix & ExtractFilename(File) & "-f" & Ext & """><img" & W & " src=""" & Prefix & ExtractFilename(File) & Ext & """ alt=""" & AltString & """ title=""Click image for full-size image (" & SizeFS(0) & " &times; " & SizeFS(1) & " pixels).""></a>"
        Else
            ImageString = "<img" & W & " src=""" & Prefix & ExtractFilename(File) & Ext & """ alt=""" & AltString & """>"
        End If

End Function
_____________________________________________________________________________________


Private Sub DisplayImageLinks()
' is button on ImageUtils sheet

'EntryType:
' 0 - interlace with <p>'s. Default.
' 1 - surround with <div class="cell">xx</div>
' 2 - same as 1, but has leading <br> with expectation title will be added to each cell
' 3 - surround with <td>xx</td>
' 4 - surround with <span class="floatLeft">xx</span>
' 5 - surround with <span class="floatLeft"><a href=".htm">xx</a></span>
' 6 - surround with <span class="floatRight">xx</span>
' 7 - surround with <span class="floatRight"><a href=".htm">xx</a></span>
' 8 - surround with <p> and <hr>
' 9 - interlace with <br>'s
' 10 - javascript slide show (all found will be in slide show) -> all must be same size
' 11 - cell container for thumbnail

    Dim KeepTNflag As Boolean, WidePicFlag As Boolean
    Dim i As Integer, k As Integer
    Dim EntryType As String, Ext As String, Filter As String, Path As String, Prefix As String, S As String, StrRes As String

    Path = GetImagePath
    Prefix = Range("CreateLinksPrefix").Value
    Filter = Range("CreateLinksFilter").Value
    EntryType = Range("CreateLinksType").Value
    If Len(EntryType) = 0 Then EntryType = 0
    Ext = Range("CreateLinksFile").Value
    If Len(Ext) = 0 Then Ext = ".jpg"
    i = Range("CreateLinksUL").Row
    KeepTNflag = False
    WidePicFlag = Range("CreateLinksWide").Value

    ClearImageLinks
    RestoreInputCells "CreateLinksFilter"

    Application.StatusBar = "Getting filenames..."

    StrRes = CreateImageLinks(Path, EntryType, Filter, Prefix, WidePicFlag, Ext, KeepTNflag, True)

' ~~ print to sheet
    If Len(StrRes) > 0 Then
        With Sheets("ImageUtils")
            Do
                S = Left(StrRes, InStr(StrRes, vbCrLf) - 1)
                .Cells(i, 1).Value = S
                i = i + 1
                StrRes = DropStr(StrRes, Len(S) + 2)
            Loop While Len(StrRes) > 0
        End With
    End If

    Application.StatusBar = False

End Sub
_____________________________________________________________________________________


Private Sub RemoveLinkBlankRowsImg()
' is button on ImageUtils sheet
    RemoveLinkBlankRows "CreateLinksUL", 1
End Sub
_____________________________________________________________________________________


Private Sub PutImageLinksIntoClipboard()
' is button on ImageUtils sheet

    Dim EndRow As Integer, StartRow As Integer
    Dim Col As String

    With Sheets("ImageUtils")
        StartRow = .Range("CreateLinksUL").Row
        If Range("CreateLinksUL").Value = "Width" Then
            Col = "D"
            StartRow = StartRow + 1
        Else
            Col = "A"
        End If
        EndRow = .Range(Col & "65536").End(xlUp).Row
        If EndRow >= StartRow Then
            .Range(Col & StartRow & ":" & Col & EndRow).Copy
        End If
    End With

End Sub
_____________________________________________________________________________________


Sub ClearImageLinks()
' is button on ImageUtils sheet

    Application.ScreenUpdating = False
    If ActiveCell.Row > Range("CreateLinksUL").Row Then
        Range("CreateLinksUL").Select
    End If
    Sheets("ImageUtils").Range("A" & Range("CreateLinksUL").Row & ":E65536").Clear
    
End Sub
_____________________________________________________________________________________


Private Sub ClearMore()
' is button on ImageUtils sheet

    ClearImageLinks
    Range("ImgUtilPath2").Clear
    RestoreInputCells "ImgUtilPath2"
    Range("ListFilter").Clear
    RestoreInputCells "ListFilter"
    Range("Filter").Clear
    RestoreInputCells "Filter"
    Range("CreateLinksFilter").Clear
    RestoreInputCells "CreateLinksFilter"

End Sub
_____________________________________________________________________________________