ник: Hush
Кто подскажет почему вылезает ошибка "Нарушены границы массива"?
Файлов в папке было 14 шт.
Function GetMessage(FindSubject1 As String, FindSubject2 As String, _
MyFilePath As String, strEntryID As String, _
strLoadFolder As String, strLoadedFolder As String)
Dim MySubject As String
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As MAPIFolder
Dim myItem As MailItem
Dim myAttachments As Attachments
Dim myAttach As Attachment
Dim i As Long, X As Long, j As Long
Dim OlNotRunning As Boolean
'On Error Resume Next
Set myOlApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
OlNotRunning = True
Err.Clear
Set myOlApp = CreateObject("Outlook.Application")
End If
'=====================================================
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.Session.GetFolderFromID(strEntryID)
X = myFolder.Items.Count
With myFolder
For i = 1 To X
Set myItem = .Items(i)
MySubject = myItem.Subject
If MySubject Like "*" & FindSubject1 & "*" & FindSubject2 & "*" Then
Set myAttachments = myItem.Attachments
If myAttachments.Count > 0 Then
For j = 1 To myAttachments.Count
Set myAttach = myAttachments(j)
myAttach.SaveAsFile MyFilePath & "\" & i & j & "_" & myAttach.FileName
myItem.UnRead = False
Next j
If IsExistMailFolder(myFolder, strEntryID, strLoadedFolder) Then
myItem.Move .Folders(strLoadedFolder)
Else
.Folders.Add (strLoadedFolder)
myItem.Move .Folders(strLoadedFolder)
End If
End If
End If
Next i
End With
If OlNotRunning = True Then
Set myOlApp = Nothing
myOlApp.Quit
End If
End Function