Outlook задача обработки писем - VB

Формулировка задачи:

Привет всем! Есть такая цель, опишу ниже подробнее На почту приходят алармы в определенный ящик мейлбокса, Шапка письма backserver: backserv: Backup group aborted: SHS-EIT-daily (already running) Текст: NetWorker savegroup: (alert) Group SHS-EIT-daily aborted, savegrp is already running Надо каким-то образом вытащить из письма информацию и загнать в эксель, таким образом вытащить имя упавшей бекап группы, в нашем случае SHS-EIT-daily создать новое письмо, указав кому, и в текст вставить имя этой группы. Пока я не знаю как забирать инфо из Оутлука вообще.

Решение задачи: «Outlook задача обработки писем»

textual
                            Листинг программы 
                        
 
                            
                        
Function CorrectFaleName(ByVal FName As String) As String
arrA = Array(34, 42, 47, 58, 60, 62, 63, 92, 124)
arrB = Array(39, 149, 178, 59, 171, 187, 33, 178, 178)
tmpString = FName
For i = 1 To 31
tmpString = Replace(tmpString, Chr(i), "") 'удаляю непечат. символы
Next i
 
For i = 0 To 8
tmpString = Replace(tmpString, Chr(arrA(i)), Chr(arrB(i))) 'удаляю остальные символы
Next i
 
CorrectFaleName = tmpString
End Function
 
Function DateFormat(ByVal Dt As Date) As String
Dim D
Dim T
D = Year(Dt) & "-" & Format(Month(Dt), "00") & "-" & Format(Day(Dt), "00")
T = Format(Hour(Dt), "00") & "." & Format(Minute(Dt), "00") & "." & Format(Second(Dt), "00")
DateFormat = D & " " & T
End Function
 
Sub test()
Set InboxFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
'Set InboxFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
 
If InboxFolder.Items.Count = 0 Then Exit Sub
For i = 1 To InboxFolder.Items.Count
    Set CurrItem = InboxFolder.Items(i)
    
    iName = CurrItem.SenderName
    iFormat = CurrItem.BodyFormat
    iTime = CurrItem.ReceivedTime 'принято на сервер
    iTopic = CurrItem.ConversationTopic
    'iTime1 = CurrItem.CreationTime 'принято на комп
    'iSize = CurrItem.Size \ 1024 & " Кб"
    
    CurrItem.BodyFormat = olFormatHTML
    
    newDir = "C:\_123\" & iName
    If Dir(newDir, vbDirectory) = "" Then MkDir newDir
    
    'CurrItem.SaveAs "C:\_123\" & DateFormat(iTime) & " - " & iTopic & ".htm", olHTML
    'CurrItem.SaveAs "C:\_123\" & DateFormat(iTime) & ".htm", olHTML
    'CurrItem.SaveAs "C:\_123\" & iName & "\" & DateFormat(iTime) & ".htm", olHTML
    CurrItem.SaveAs newDir & "\" & DateFormat(iTime) & " - " & CorrectFaleName(iTopic) & ".htm", olHTML
    'CurrItem.SaveAs newDir & "\" & DateFormat(iTime) & ".htm", olHTML
Next
'msgbox "OK!"
End Sub