Function Outlook_FileAtchmt(sSubjectLn As String, sSaveAsFilePath As String, _
                                sUnzipToPath As String) As Boolean
'Purpose  : Get zipped file attachment from email and save it as a file in the
'           folder specified by sSaveFilePath.
'DateTime : 8/12/2000 09:13
'Author   : Bill Mosca
'Requires : Outlook reference library
'Note     : It may be necessary to add a date/time suffix to the file to prevent overwriting
'           if the name is always the same.     
    Dim objOLApp As New Outlook.Application     'early binding
    Dim outFolder As MAPIFolder
    Dim outNameSpace As NameSpace
    Dim outItem
    Dim outAttachment As Attachment
    Dim AttachmentCopy As Attachment
    Dim sFile As String
    On Error GoTo err_Outlook_FileAtchmt
    
    'make sure file path ends with backslash
    If Right(sSaveAsFilePath, 1) <> "\" Then
        sSaveAsFilePath = sSaveAsFilePath & "\"
    End If
    
    sSubjectLn = UCase(sSubjectLn)    'make it all CAPS
    Set outNameSpace = objOLApp.GetNamespace("MAPI")
    
'***************************************************************************************
'If logIn is to be required, uncomment this section and LogOff line at end of function
'after mailbox is established and change code to prompt for password.
'Otherwise delete section.
'
'    'log on to Outlook as user with access to ATS mailbox.
'    'Show Profile dialog;use new session
'    outNameSpace.Logon "<Profile Name goes here>", "<Password goes here>", True, True
'***************************************************************************************
    
    Set outFolder = outNameSpace.GetDefaultFolder(olFolderInbox)
     
    'Loop through all items in mailbox. Get email by subject.
    For Each outItem In outFolder.Items
        If UCase(outItem.Subject) = sSubjectLn Then
            'Get all attachments and save them as files in ATS_Files folder
            For Each outAttachment In outItem.Attachments
                sFile = outAttachment.Filename
                'save attachment as file to specified folder
                outAttachment.SaveAsFile sSaveAsFilePath & sFile
            Next
            
            'Unzip file to import folder
            If UnZipFile(sSaveAsFilePath, sFile, sUnzipToPath) Then
                outItem.UnRead = False
                Outlook_FileAtchmt = True
            Else: MsgBox "Could not unzip file." & vbNewLine & "Import Process has been terminated", _
                vbCritical
                Exit Function
            End If
        End If
    Next
    
    'clear instance of Outlook from memory
    Set objOLApp = Nothing
exit_Outlook_FileAtchmt:
    On Error Resume Next
    Set outFolder = Nothing
    Set outNameSpace = Nothing
    Exit Function
    
err_Outlook_FileAtchmt:
    MsgBox "Error " & Err.Description
    Resume Next

End Function