Let Navision Scan Inbox and extract attachment

Public Sub StripAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolder As String

    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

    ' Get the Temp folder.
    strFolder = GetTempDir()
    If strFolder = "" Then
        MsgBox "Could not get Temp folder", vbOKOnly
        GoTo ExitSub
    End If

    ' Check each selected item for attachments.
    ' If attachments exist, save them to the Temp
    ' 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
            lngCount = objAttachments.Count
            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.
                    strFile = strFolder & strFile
                    ' Save the attachment as a file.
                    objAttachments.Item(i).SaveAsFile strFile
                    ' Delete the attachment.
                    objAttachments.Item(i).Delete
                Next i
            End If
            objMsg.Save
        End If
    Next

ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

Private Function GetTempDir() As String
    Const TemporaryFolder = 2

    Dim fso As Scripting.FileSystemObject
    Dim tFolder As Scripting.Folder

    On Error Resume Next

    ' Instantiate a WSH (Windows Scripting Host)
    ' FileSystemObject.
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Get the Temp folder.
    Set tFolder = fso.GetSpecialFolder(TemporaryFolder)

    If Err Then
        GetTempDir = ""
    Else
        GetTempDir = LCase(tFolder.Path)
        ' Add "\" to the rightmost part of the path to
        ' the Temp folder if necessary.
        If Right$(GetTempDir, 1) <> "\" Then
            GetTempDir = GetTempDir & "\"
        End If
    End If

    Set fso = Nothing
    Set tFolder = Nothing
End Function