Outlook 2003 vba macro

  • Thread starter Thread starter Grant
  • Start date Start date
G

Grant

My macro loops through all the messages in the inbox and moves them to a
folder in Public Folders.
The problem is the inbox view is set to "View by date' and 'Show in groups'
so the macro copies all mail items from a certain day and then stops.

For example at the moment I have mail items from 'Today' and 'Yesterday' and
'Last week' etc. I will need to run the macro 3 times to move items from
each group. Instead of changing the view is there a way around this grouping
thing in Outlook 2003?

Thanks,
Grant
 
Show the relevant section of your code. Looping through the items in a
folder is independent of a folder's current view.
 
Heres the code (Im new to vba and this code is just me learning the outlook
object model) - the error catch is there because the loop doesnt like
'undeliverable' items. The loop works fine but I have to run it for each
group - ie 'today'. 'yesterday', 'last week'.

Dim objApp As Application
Dim objNS As NameSpace
Dim objInbox As MAPIFolder
Dim objPersonalFolder As MAPIFolder
Dim objPersonalInbox As MAPIFolder
Dim strHandyString As String
Dim strMovedEmailItems As String


strMovedEmailItems = "The following mail items were moved:" & vbCrLf &
vbCrLf

Set objApp = CreateObject("outlook.application")
Set objNS = objApp.GetNamespace("mapi")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objMailItem = objInbox.Items

'Set the personal folder object
For Each objfoldername In objNS.Folders
If objfoldername = "Personal Folders" Then
Set objPersonalFolder = objfoldername
End If

Next

'Set the backup inbox folder object
For Each objPersFolderName In objPersonalFolder.Folders
strHandyString = strHandyString & vbCrLf & objPersFolderName
If objPersFolderName = "Backup Inbox" Then
Set objPersonalInbox = objPersFolderName
End If
Next

'Move the email Item to the backup folder
For Each objMailItem In objInbox.Items
objMailItem.Move objPersonalInbox
If Err.Number = 438 Then
GoTo skip
End If
Err.Clear
strMovedEmailItems = strMovedEmailItems & vbCrLf & objMailItem.Subject &
_
" - " & objMailItem.SenderName
skip:
Next


'Show the form with the results
'FrmResultsShow (strHandyString)
FrmResultsShow (strMovedEmailItems)
 
Don't move or delete items in a For Each loop! The index is reset each time,
which means you'll move only half. There are several different correct
approaches. One is a countdown loop:

'Move the email Item to the backup folder
intCount = objInbox.Items.Count
For i = intCount to 1 Step -1
Set objMailItem = objInbox.Items(i)
objMailItem.Move objPersonalInbox
If Err.Number = 438 Then
GoTo skip
End If


--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Repeating: Don't try to delete or move items inside a For Each ... Next
loop.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Willy said:
Another way of doing it is to use a for each loop

Dim msg as mailItem
For each msg in objMailItem

'your code

next

----- Sue Mosher [MVP-Outlook] wrote: -----

Don't move or delete items in a For Each loop! The index is reset each time,
which means you'll move only half. There are several different correct
approaches. One is a countdown loop:

'Move the email Item to the backup folder
intCount = objInbox.Items.Count
For i = intCount to 1 Step -1
Set objMailItem = objInbox.Items(i)
objMailItem.Move objPersonalInbox
If Err.Number = 438 Then
GoTo skip
End If

Grant said:
Heres the code (Im new to vba and this code is just me learning the outlook
object model) - the error catch is there because the loop doesnt like
'undeliverable' items. The loop works fine but I have to run it for each
group - ie 'today'. 'yesterday', 'last week'.
Dim objNS As NameSpace
Dim objInbox As MAPIFolder
Dim objPersonalFolder As MAPIFolder
Dim objPersonalInbox As MAPIFolder
Dim strHandyString As String
Dim strMovedEmailItems As String
Set objNS = objApp.GetNamespace("mapi")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
For Each objfoldername In objNS.Folders
If objfoldername = "Personal Folders" Then
Set objPersonalFolder = objfoldername
End If
For Each objPersFolderName In objPersonalFolder.Folders
strHandyString = strHandyString & vbCrLf & objPersFolderName
If objPersFolderName = "Backup Inbox" Then
Set objPersonalInbox = objPersFolderName
End If
Next
For Each objMailItem In objInbox.Items
objMailItem.Move objPersonalInbox
If Err.Number = 438 Then
GoTo skip
End If
Err.Clear
strMovedEmailItems = strMovedEmailItems & vbCrLf &
Click to expand...
objMailItem.Subject
&> _
" - " & objMailItem.SenderName
skip:
Next
'Show the form with the results
Click to expand...
'FrmResultsShow (strHandyString)
FrmResultsShow (strMovedEmailItems)
"Sue Mosher [MVP-Outlook]" <[email protected]> wrote in
Click to expand...
message
Show the relevant section of your code. Looping through the items in a
folder is independent of a folder's current view.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

My macro loops through all the messages in the inbox and moves
Click to expand...
Click to expand...
them to
a items
from
Click to expand...
Click to expand...
 
Back
Top