Outlook Macro keeps breaking

[amorrison2006]

Hello

I really hope there is someone who could help with this slight
problem.

I use the following macro and it keeps breaking on me;

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

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

It works on a good number of emails in the folder however it then
gives me the following error at times.

I do not know why;

The error is

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

Please someone help;

Many thanks

Andrea