M
MikeC
I'm preparing to use Outlook Redemption to save file
attachments, but I'm having difficulty finding
documentation that explains how to do this. The
Redemption website has lots of code fragments and
descriptions of various objects, but I can't seem to find
anything that directly pertains to what I'm trying to do.
To use Redemption, I'm supposed to change how I declare my
Outlook objects and set a the Item property of any
Redemption objects to an Outlook property. Can anyone
tell me how to do this with the below code?
=======================================================
Public Function SaveAttached()
On Error GoTo Err_SaveAttached
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
Dim myNameSpace As NameSpace
' Get the destination folder.
strFolder = "C:\" 'Test folder
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
Set myNameSpace = objOL.GetNamespace("MAPI")
myNameSpace.Logon "UserName", "Password", False, False
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Check each selected item for attachments.
' If attachments exist, save them to the specified
folder
For Each objMsg In objSelection
' save 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
For i = lngCount To 1 Step -1
' Save attachment from item.
' Get the file name.
strFile = objAttachments.Item
(i).FileName
' Combine with the path to the
Specified folder.
strFile = strFolder & strFile
' Save the attachment if the file name
matches the specified string.
' The characters at the beginning of
the file name are variable.
If Right(strFile, 17)
= "_USD_s_bid_ib.csv" Then
objAttachments.Item(i).SaveAsFile
strFile
End If
Next i
End If
End If
Next
myNameSpace.Logoff
Exit_SaveAttached:
On Error Resume Next
Set objOL = Nothing
Set myNameSpace = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objAttachments = Nothing
Exit Function
Err_SaveAttached:
If Err.Number <> 2501 Then
MsgBox "Module: " & vbTab & vbTab & "Module1" &
vbCrLf _
& "Procedure #: " & vbTab & "1" & vbCrLf _
& "Error #: " & vbTab & vbTab & Err.Number &
vbCrLf _
& "Description: " & vbTab & Err.Description
Else
Resume Exit_SaveAttached
End If
End Function
attachments, but I'm having difficulty finding
documentation that explains how to do this. The
Redemption website has lots of code fragments and
descriptions of various objects, but I can't seem to find
anything that directly pertains to what I'm trying to do.
To use Redemption, I'm supposed to change how I declare my
Outlook objects and set a the Item property of any
Redemption objects to an Outlook property. Can anyone
tell me how to do this with the below code?
=======================================================
Public Function SaveAttached()
On Error GoTo Err_SaveAttached
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
Dim myNameSpace As NameSpace
' Get the destination folder.
strFolder = "C:\" 'Test folder
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
Set myNameSpace = objOL.GetNamespace("MAPI")
myNameSpace.Logon "UserName", "Password", False, False
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Check each selected item for attachments.
' If attachments exist, save them to the specified
folder
For Each objMsg In objSelection
' save 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
For i = lngCount To 1 Step -1
' Save attachment from item.
' Get the file name.
strFile = objAttachments.Item
(i).FileName
' Combine with the path to the
Specified folder.
strFile = strFolder & strFile
' Save the attachment if the file name
matches the specified string.
' The characters at the beginning of
the file name are variable.
If Right(strFile, 17)
= "_USD_s_bid_ib.csv" Then
objAttachments.Item(i).SaveAsFile
strFile
End If
Next i
End If
End If
Next
myNameSpace.Logoff
Exit_SaveAttached:
On Error Resume Next
Set objOL = Nothing
Set myNameSpace = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objAttachments = Nothing
Exit Function
Err_SaveAttached:
If Err.Number <> 2501 Then
MsgBox "Module: " & vbTab & vbTab & "Module1" &
vbCrLf _
& "Procedure #: " & vbTab & "1" & vbCrLf _
& "Error #: " & vbTab & vbTab & Err.Number &
vbCrLf _
& "Description: " & vbTab & Err.Description
Else
Resume Exit_SaveAttached
End If
End Function