Outlook Objects...

[AZSEEK]

i have code that deattaches "attachments" from a message and stores them in a certain directory... it works fine until i issue instructions to either move or delete a message... what it does, it only loops through once even though the collection as more messages... any way around this

 

[bjd4jc]

see faq222-2244 and give more info.

 

[AZSEEK]

when I insert this line -

oMessage.Move objProcessedFolder - the loop only goes through once even tho the collection holds more and if I remove the line the entire collection is gone thru...

Public Function SaveAttachments(Optional PathName As String) As Boolean

Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As MAPIFolder
Dim oMessage As Object
Dim SpATHnAME As String
Dim oAttachment As Outlook.Attachment
Dim IcTR As Integer
Dim IaTTACHCNT As Integer
Dim objProcessedFolder As MAPIFolder

'On Error GoTo ErrHandler

If PathName = "" Then
SpATHnAME = GetTempDir
Else
SpATHnAME = PathName
End If

If Right(SpATHnAME, 1) <> "\" Then SpATHnAME = SpATHnAME & "\"
If Dir(SpATHnAME, vbDirectory) = "" Then Exit Function

Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
Set objProcessedFolder = oFldr.Folders("Processed")

For Each oMessage In oFldr.Items

With oMessage.Attachments
IaTTACHCNT = .Count
If IaTTACHCNT > 0 Then
For IcTR = 1 To IaTTACHCNT
.Item(IcTR).SaveAsFile SpATHnAME _
& .Item(IcTR).FileName
Next IcTR
End If
End With
DoEvents

'oMessage.UnRead = False
'oMessage.Delete
oMessage.Move objProcessedFolder

Next

SaveAttachments = True

'ErrHandler:
'Set oMessage = Nothing
'Set oFldr = Nothing
'Set oNs = Nothing
'Set oOutlook = Nothing
End Function