Sub OpenLinksAndDownloadToCatsFolderSilently()
    Dim rng As Range
    Dim cell As Range
    Dim text As String
    Dim startPos As Long
    Dim endPos As Long
    Dim linkText As String
    Dim folderPath As String
    Dim success As Boolean
    
    ' 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
            On Error Resume Next
            Shell "cmd /c start " & linkText, vbHide
            On Error GoTo 0
            
            '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
                
                ' Copy the downloaded file to the "cats" folder
                On Error Resume Next
                FileCopy ThisWorkbook.Path & "\Downloads\" & recentFileName, newFilePath
                success = (Err.Number = 0)
                On Error GoTo 0
                
                If success Then
                    ' Delete the downloaded file from the original location
                    On Error Resume Next
                    Kill ThisWorkbook.Path & "\Downloads\" & recentFileName
                    success = (Err.Number = 0)
                    On Error GoTo 0
                    
                    If success Then
                        MsgBox "File moved to the 'cats' folder.", vbInformation, WLTitleId
                    Else
                        MsgBox "Error deleting the original file.", vbExclamation, WLTitleId
                    End If
                Else
                    Dim response As VbMsgBoxResult
                    response = MsgBox("Permission needed to move the file. Would you like to manually move it?", vbQuestion + vbYesNo, WLTitleId)
                    If response = vbYes Then
                        MsgBox "Please move the file manually to the 'cats' folder.", vbInformation, WLTitleId
                    End If
                End If
            End If
        End If
    Next cell
    
    MsgBox "Files processed.", 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