Sub OpenLinksAndDownloadToCatsFolderSilently()
    Dim rng As Range
    Dim cell As Range
    Dim WLTitleId As String
    Dim text As String
    Dim startPos As Long
    Dim endPos As Long
    Dim linkText As String
    Dim folderPath As String
    
    ' Get the path of the folder where the workbook is located
    folderPath = ThisWorkbook.Path & "\cats\"
    
    ' Check if the "cats" folder exists, if not, create it
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    
    'Window Heading
    WLTitleId = "Open Links and Download to 'cats' Folder"
    
    'Set Range
    On Error Resume Next
    Set rng = Application.InputBox("Select the range with text:", WLTitleId, Type:=8)
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "No valid range selected.", vbExclamation, WLTitleId
        Exit Sub
    End If
    
    'Loop through each cell in the selected range
    For Each cell In rng
        text = cell.Value
        
        'Search for the pattern of a potential link
        startPos = InStr(1, text, "http://")
        If startPos = 0 Then startPos = InStr(1, text, "https://")
        
        'If a link pattern is found, extract the link text
        If startPos > 0 Then
            endPos = InStr(startPos, text, " ")
            If endPos = 0 Then
                linkText = Mid(text, startPos)
            Else
                linkText = Mid(text, startPos, endPos - startPos)
            End If
            
            'Create a hyperlink
            cell.Hyperlinks.Add _
                Anchor:=cell, _
                Address:=linkText, _
                TextToDisplay:=linkText
            
            'Open the link in the default web browser silently
            Shell "cmd /c start " & linkText, vbHide
            
            'Wait for a brief moment (adjust as needed) to give the browser time to start downloading
            Application.Wait Now + TimeValue("00:00:03")
            
            'Move the downloaded file to the "cats" folder
            Dim recentFileName As String
            recentFileName = GetMostRecentFileFromFolder(ThisWorkbook.Path & "\Downloads\")
            
            If Len(recentFileName) > 0 Then
                Dim newFilePath As String
                newFilePath = folderPath & recentFileName
                Name ThisWorkbook.Path & "\Downloads\" & recentFileName As newFilePath
            End If
        End If
    Next cell
    
    MsgBox "Files downloaded to the 'cats' folder.", vbInformation, WLTitleId
End Sub

Function GetMostRecentFileFromFolder(folderPath As String) As String
    Dim fileName As String
    Dim mostRecentDate As Date
    Dim mostRecentFile As String
    
    fileName = Dir(folderPath & "\*.*", vbNormal)
    Do While Len(fileName) > 0
        If FileDateTime(folderPath & "\" & fileName) > mostRecentDate Then
            mostRecentDate = FileDateTime(folderPath & "\" & fileName)
            mostRecentFile = fileName
        End If
        fileName = Dir
    Loop
    
    GetMostRecentFileFromFolder = mostRecentFile
End Function