A
amorrison2006
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("Client").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
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("Client").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