Macro to save attachments from an outlook shared inbox to a drive location

Hi,

I recently found a macro that I run from within Outlook to save attachments to a disk from messages I highlight before I run the outlook macro. Works well and saves me ages but I was wondering if such a macro can be extended to do the following:

1/ When triggered highlight all the messages in the shared inbox automatically so I do not have to do this manually.

2/ Be triggered via an button on an Excel workbook taking some parameters such as location to save the files from cells on the worksheet.

Here is the macro:

Public Sub SaveAttachments_M()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim StrFile As String
Dim StrFolderPath As String
Dim strDeletedFiles As String
Dim dateFormat

StrFolderPath = BrowseForFolder & "\"

' Get the path to your My Documents folder
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
'strFolderpath = "C:\Temp\M\"


' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and strip them from the item.
For Each objMsg In objSelection

    ' This code only strips attachments from mail items.
    ' If objMsg.class=olMail Then
    ' Get the Attachments collection of the item.
    Set objAttachments = objMsg.Attachments
    dateFormat = Format(objMsg.ReceivedTime, "ddmmyy-hhmmss")
    lngCount = objAttachments.Count
    strDeletedFiles = ""

    If lngCount > 0 Then

        ' We need to use a count down loop for removing items
        ' from a collection. Otherwise, the loop counter gets
        ' confused and only every other item is removed.

        For i = lngCount To 1 Step -1

            ' Save attachment before deleting from item.
            ' Get the file name.
            StrFile = objAttachments.Item(i).FileName

            ' Combine with the path to the Temp folder.
            If Left(StrFile, 4) = "MITA" And Mid(StrFile, 10, 3) <> "_AR" Then
                If Right(StrFile, 3) = "xls" Then
                    StrFile = StrFolderPath & Left(StrFile, 9) & "-" & dateFormat & Right(StrFile, 4)
                Else: StrFile = StrFolderPath & Left(StrFile, 9) & "-" & dateFormat & Right(StrFile, 5)
                End If
            ElseIf Mid(StrFile, 10, 3) <> "_AR" Then
                StrFile = StrFolderPath & StrFile
            End If

            ' Save the attachment as a file.
            objAttachments.Item(i).SaveAsFile StrFile
        
        Next i
       
    End If
Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing