It looks like you are trying to incorporate something from http://www.vbaexpress.com/forum/show...Genius-needed:
i = 0
JumpHere:
If Dir(stFileName) = "" then
objAtt.SaveAsFile stFileName
else
i=i+1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
goto Jumphere
end if
Try this untested code.
For i = 1 To Folders.Count
StrFolder = StripIllegalChar(Folders(i))
n = InStr(3, StrFolder, "\") + 1
StrFolder = Mid(StrFolder, n, 256)
StrFolderPath = StrSavePath & StrFolder & "\"
StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
If Not FSO.FolderExists(StrFolderPath) Then
FSO.CreateFolder (StrFolderPath)
End If
Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
' On Error Resume Next ' <-- I suggest you comment this out when debugging
For j = 1 To SubFolder.Items.Count
Set mItem = SubFolder.Items(j)
StrReceived = ArrangedDate(mItem.ReceivedTime)
StrSubject = mItem.Subject
StrName = StripIllegalChar(StrSubject)
' StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg"
' StrFile = Left(StrFile, 256)
StrFile = Left(StrSaveFolder & StrReceived & "_" & StrName, 251) & ".msg"
k = 0 ' <--- i is already being used
JumpHere:
If Dir(StrFile) = "" then
mItem.SaveAs StrFile, 3
else
k=k+1
StrFile = Left(StrSaveFolder & StrReceived & "_" & StrName, 251) & k & ".msg"
goto Jumphere
end if
mItem.SaveAs StrFile, 3
Next j
On Error Goto 0
Next i