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 On Error Resume Next Name ThisWorkbook.Path & "\Downloads\" & recentFileName As newFilePath success = (Err.Number = 0) On Error GoTo 0 If success Then MsgBox "File moved to the 'cats' folder.", vbInformation, WLTitleId 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