Hello

I have been using the below email for a while now;

I just have to keep running it to bypass by error message but now I am
receiving too many emails to keep doing this,

Can someone please tell me how to resolve this run time error?

Run time error '-2147352567 (80020009)
Array index out of bounds

My macro is

Public Function StripChars(ByVal sStr) As String
sStr = Replace(sStr, """", "")
sStr = Replace(sStr, "'", "")
sStr = Replace(sStr, ":", "")
sStr = Replace(sStr, "/", "-")
sStr = Replace(sStr, "\", "-")
sStr = Replace(sStr, "?", "")
StripChars = sStr
End Function

Sub CopyEmailMsg()


Dim myApp As Application
Dim myNS As NameSpace
Dim myFolder As Object
Dim myItems As Outlook.MailItem
'Dim oAttachments As Outlook.Attachments


Set myApp = New Outlook.Application
Set myNS = myApp.GetNamespace("MAPI")
Set myFolder =
myNS.GetDefaultFolder(olFolderInbox).Folders("Clie nt").Folders("Subclient")
'Set myItems = myFolder.Items
Set myDestFolder = myFolder.Folders("Subclient1")


For Count = 1 To myFolder.Items.Count
Set myMail = myFolder.Items(Count)


myMail.SaveAs "C:\emails\" & StripChars(myMail.Subject) & ".msg",
olMSG


myMail.Move myDestFolder
Next Count

MsgBox "The emails have been copied and saved"


End Sub

It does work but the only real problem is that I have to keep running
it in order for it to process all the emails.

I appreciate anyone's help with a revised code....I'm not an expert in
this area,

Thanks so much

Andrea

use a backwards counting loop

For Count = myFolder.Items.Count To 1 step -1
....
Next

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Quick-Cats - Categorize Outlook data:
http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6

Am 16 May 2007 08:19:49 -0700 schrieb :

Hello

I have been using the below email for a while now;

I just have to keep running it to bypass by error message but now I am
receiving too many emails to keep doing this,

Can someone please tell me how to resolve this run time error?

Run time error '-2147352567 (80020009)
Array index out of bounds

My macro is

Public Function StripChars(ByVal sStr) As String
sStr = Replace(sStr, """", "")
sStr = Replace(sStr, "'", "")
sStr = Replace(sStr, ":", "")
sStr = Replace(sStr, "/", "-")
sStr = Replace(sStr, "\", "-")
sStr = Replace(sStr, "?", "")
StripChars = sStr
End Function

Sub CopyEmailMsg()


Dim myApp As Application
Dim myNS As NameSpace
Dim myFolder As Object
Dim myItems As Outlook.MailItem
'Dim oAttachments As Outlook.Attachments


Set myApp = New Outlook.Application
Set myNS = myApp.GetNamespace("MAPI")
Set myFolder =

myNS.GetDefaultFolder(olFolderInbox).Folders("Clie nt").Folders("Subclient")
'Set myItems = myFolder.Items
Set myDestFolder = myFolder.Folders("Subclient1")


For Count = 1 To myFolder.Items.Count
Set myMail = myFolder.Items(Count)


myMail.SaveAs "C:\emails\" & StripChars(myMail.Subject) & ".msg",
olMSG


myMail.Move myDestFolder
Next Count

MsgBox "The emails have been copied and saved"


End Sub

It does work but the only real problem is that I have to keep running
it in order for it to process all the emails.

I appreciate anyone's help with a revised code....I'm not an expert in
this area,

Thanks so much

Andrea