Private Sub AppLication_NewMail()
Dim tema As String
Dim Olbody As String
Dim zadacha As String
Dim OlTime As Date
Dim srok As Date
Dim fail As String
Dim poluchatel As String



tema = "ÅÏÌ:"
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myfolder1 = myfolder.Folders("ÅÏÌ").Items
Set myitem = myfolder1.GetLast 'getlast - ïîñëåäíåå ïèñüìî!!!!
OlSubject = myitem.Subject

If myitem.UnRead = False Then 'áëîê
'Quit (WB)
Exit Sub
End If



If InStr(1, OlSubject, tema) <= 1 Then

 Z = MsgBox("&#208;&#224;&#225;&#238;&#242;&#229;&#237;&#234;&#224; &#239;&#240;&#232;&#235;&#229;&#242;&#229;&#235;&#224;, &#228;&#238;&#225;&#224;&#226;&#235;&#255;&#229;&#236; &#226; &#197;&#207;&#204;?", vbYesNo)
 If Z = 7 Then
 Exit Sub
 End If



 Olbody = myitem.Body
 OlTime = myitem.SentOn
 
 Set EX = CreateObject("Excel.Application")
 Set WB = EX.Workbooks.Open("1.xlsm")
 
 a = InStr(1, Olbody, "&#199;&#224;&#228;&#224;&#247;&#224;: ")
 b = InStr(a, Olbody, "%%") '&#239;&#238;&#236;&#229;&#237;&#255;&#242;&#252; &#237;&#224; %%
 c = b - a
 zadacha = Mid(Olbody, a + 8, c - 8)
 WB.Worksheets("&#203;&#232;&#241;&#242;1").Range("A2").Value = zadacha
 
 WB.Worksheets("&#203;&#232;&#241;&#242;1").Range("B2").Value = OlTime
 
 a = InStr(1, Olbody, "&#209;&#240;&#238;&#234;: &#228;&#238; ")
 b = InStr(a, Olbody, "%%") '&#239;&#238;&#236;&#229;&#237;&#255;&#242;&#252; &#237;&#224; %%
 c = b - a
 srok = Mid(Olbody, a + 9, c - 9)
 WB.Worksheets("&#203;&#232;&#241;&#242;1").Range("C2").Value = srok
  
 If InStr(1, Olbody, "&#208;&#224;&#225;&#238;&#247;&#232;&#233; &#244;&#224;&#233;&#235;: ") > 0 Then
 a = InStr(1, Olbody, "&#208;&#224;&#225;&#238;&#247;&#232;&#233; &#244;&#224;&#233;&#235;: ") '&#239;&#238;&#236;&#229;&#237;&#255;&#242;&#252; &#237;&#224; &#208;&#224;&#225;&#238;&#247;&#232;&#233; &#244;&#224;&#233;&#235;
 b = InStr(a, Olbody, "%%") '&#239;&#238;&#236;&#229;&#237;&#255;&#242;&#252; &#237;&#224; %%
 c = b - a
 fail = Mid(Olbody, a + 10, c - 10) '&#239;&#238;&#241;&#235;&#229; &#232;&#231;&#236;&#229;&#237;&#229;&#237;&#232;&#255; &#225;&#243;&#228;&#229;&#242; &#237;&#229; 10
 WB.Worksheets("&#203;&#232;&#241;&#242;1").Range("D2").Value = fail
 End If
 
 poluchatel = myitem.CC + "; " + myitem.To
 
 WB.Worksheets("&#203;&#232;&#241;&#242;1").Range("E2").Value = poluchatel
 
 
 
 MsgBox "&#229;&#241;&#242;&#252;"

 Else
  MsgBox "&#237;&#229;&#242;&#243;"
  Exit Sub
 End If
 WB.Application.Visible = True
 On Error GoTo 111
 WB.Application.Run "EMP_copy"
111
End Sub