Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Private WithEvents Items As Outlook.Items
- Private Sub Application_Startup()
- Dim olApp As Outlook.Application
- Dim objNS As Outlook.NameSpace
- Set olApp = Outlook.Application
- Set objNS = olApp.GetNamespace("MAPI")
- ' default local Inbox
- Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
- End Sub
- Private Sub Items_ItemAdd(ByVal item As Object)
- On Error GoTo ErrorHandler
- Dim Msg As Outlook.MailItem
- If TypeName(item) = "MailItem" Then
- Set Msg = item
- ' ******************
- ' do something here
- ' ******************
- End If
- ProgramExit:
- Exit Sub
- ErrorHandler:
- MsgBox Err.Number & " - " & Err.Description
- Resume ProgramExit
- End Sub
- Private Sub Application_NewMail()
- 'MsgBox "Íîâîå ïèñüìî "
- Call ZNO_ZMMDOC_CRE
- End Sub
- Public Sub ZNO_ZMMDOC_CRE()
- Dim DoW As String 'Äàòà íà÷àëà ðàáîò
- Dim lastrow As Long 'ïåðåìåííàÿ ïîèñêà ïîñëåäíåé ñòðîêè â Excel
- Dim myArray As Variant
- Dim i As Long
- Dim olItem As Outlook.MailItem 'ïåðåìåííàÿ, îïðåäåëÿþùàÿ ïèñüìî
- Dim sText As String 'ìàññèâ äàííûõ äëÿ ïîèñêà ñîîòâåòñòâèé ðåãåêñïîâ
- Dim Excel As Object
- Dim ExcelBook As Object
- Set ZNOnumber = CreateObject("VBScript.RegExp")
- ZNOnumber.Pattern = "(SR-[1-9]{7})"
- Set olItem = ActiveExplorer.Selection.item(1)
- sText = olItem.Body
- On Error Resume Next
- DoW = CStr(Year(Now))
- Set Excel = GetObject(, "Excel.Application")
- 'MsgBox ZNOnumber.Test(TempStr)
- If Err.Number <> 0 Then
- If olItem.SenderName = "SDesk" Then
- myArray = Split(olItem.Body, Chr(13) & Chr(10))
- If UBound(myArray) > -1 Then
- lastrow = worksheet.Cells(worksheet.Rows.Count, 1).End(xlUp).Row + 1
- For i = 0 To UBound(myArray)
- 'MsgBox myArray(i)
- If InStr(Left(myArray(i), 10), "Ïîëó÷àòåëü") > 0 Then
- If InStr(myArray(i), "Иванов") Then
- MsgBox "Íàø êëèåíò", vbApplicationModal, "ÇÍÎ"
- 'worksheet.Cells(i, 1).Value = myArray(i)
- Else
- Exit For
- End If
- ElseIf InStr(Left(myArray(i), 7), "??????:") > 0 Then
- 'worksheet.Cells(lastrow, 2).Value = myArray(i)
- ElseIf InStr(Left(myArray(i), 11), "????/?????:") > 0 Then
- 'worksheet.Cells(lastrow, 3).Value = myArray(i)
- End If
- Next i
- End If
- End If
- If InStr(olItem.SenderName, "Êîðñàêîâ Àëåêñåé Ñåðãååâè÷") Then
- 'MsgBox olItem.Body
- End If
- 'MsgBox Err.Description
- 'Set Excel = CreateObject("Excel.Application")
- 'Set xlBook = Excel.Workbooks.Add
- 'Set worksheet = Excel.Worksheets(1)
- 'Excel.Visible = True
- 'oBook.SaveAs ExcelBook
- Else
- End If
- On Error GoTo 0
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement