B
Bill-41
Hi
I'm a bit new to VBA with Outlook so I'd appreciate any help. I have a
routine that saves the attachments of certain emails based on the subject.
Then I'd like to move the emails to another folder in a different pst file.
The attachments are saving fine, but the email doesn't move to the other
folder.
Here's the code .....
Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
On Error Resume Next
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
' read e-mail information
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail
messages " & _
Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
If OLF.Items(i).Subject = "ADSL order over due join with Siebel
order status" Or OLF.Items(i).Subject = "Report: ADSL Past Pending without
RTI_Auto_Migration & Disconnects - Automated" Then
If .Attachments.Count > 0 Then
For Each Att In OLF.Items(i).Attachments
Filename = Filepath1 & Trim(Att.Filename)
Att.SaveAsFile Filename
'Debug.Print "i ", i, Trim(Att.Filename)
Next
End If
'trouble is with the line below...
OLF.Items(i).Move
OLF.Folders.Item("00--Bills_email").Folders("Bills email")
End If
End With
Wend
Set OLF = Nothing
Thanks for the help!
Bill
I'm a bit new to VBA with Outlook so I'd appreciate any help. I have a
routine that saves the attachments of certain emails based on the subject.
Then I'd like to move the emails to another folder in a different pst file.
The attachments are saving fine, but the email doesn't move to the other
folder.
Here's the code .....
Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
On Error Resume Next
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
' read e-mail information
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail
messages " & _
Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
If OLF.Items(i).Subject = "ADSL order over due join with Siebel
order status" Or OLF.Items(i).Subject = "Report: ADSL Past Pending without
RTI_Auto_Migration & Disconnects - Automated" Then
If .Attachments.Count > 0 Then
For Each Att In OLF.Items(i).Attachments
Filename = Filepath1 & Trim(Att.Filename)
Att.SaveAsFile Filename
'Debug.Print "i ", i, Trim(Att.Filename)
Next
End If
'trouble is with the line below...
OLF.Items(i).Move
OLF.Folders.Item("00--Bills_email").Folders("Bills email")
End If
End With
Wend
Set OLF = Nothing
Thanks for the help!
Bill