WestGott
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
Private Sub Application_NewMail()
GlobalVarsInit
Dim olns As NameSpace
Dim InboxFolder As MAPIFolder
Dim DstFolder As MAPIFolder
Dim MailItems As Items
Dim MyClause As String
Dim Item As MailItem
Dim ItemDate As Date
Dim DateStamp As String
Dim FileName As String
Dim LogFile As Object
Set LogFile = FSO.OpenTextFile(FSAPath & LogFileName, 8, True, 0)
Set olns = Application.GetNamespace("MAPI")
Set InboxFolder = olns.GetDefaultFolder(olFolderInbox)
Set MailItems = InboxFolder.Items
MyClause = "[Unread] = True"
Set Item = MailItems.Find(MyClause)
Do While Not (Item Is Nothing)
If Item.SenderName = "EUR_AMR_SVC_365CHG Figaro" Then
Select Case Item.Subject
Case "Protocol of employee exiting"
ItemDate = Item.SentOn
DateStamp = GetDateStamp(ItemDate)
FileName = Item.Subject & "_" & DateStamp
If Hour(ItemDate) >= 12 Then
FileName = FileName & "_2" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & EmployeeFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Employes")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName)
Case "Figaro modules downloading"
Dim AnalyseRetValue As Integer
DateStamp = GetDateStamp(Item.SentOn)
FileName = Item.Attachments.Item(1).FileName
Item.Attachments.Item(1).SaveAsFile FSAPath & FileName
AnalyseRetValue = ModulesProtocolAnalyse(FileName)
FileName = Item.Subject & "_" & DateStamp
If AnalyseRetValue = -1 Then
FileName = FileName & "_Error" & FileExtension
Else
FileName = FileName & FileExtension
End If
Item.SaveAs Path & MirrorFolderName & FileName, olMSG
Item.UnRead = False
Set DstFolder = olns.Folders(PersonalFolders).Folders("Figaro_Modules")
Item.Move DstFolder
LogFile.WriteLine (DateStamp & ";" & FileName & ";" & AnalyseRetValue)
If AnalyseRetValue > 0 Then
ForwardModulesProtocol Item
End If
Case "Figaro-Oracle contracts transfering"
FigaroOracleLettersProcessing Item, "Contracts\", "Contracts", LogFile, olns
Case "Figaro-Oracle invoices transfering"
FigaroOracleLettersProcessing Item, "Invoices\", "Invoices", LogFile, olns
Case "Figaro-Oracle export sales transfering"
FigaroOracleLettersProcessing Item, "Export sales\", "Export_Sales", LogFile, olns
End Select
End If
Set Item = MailItems.FindNext
Loop
End Sub
|
|
Всего записей: 96 | Зарегистр. 10-04-2010 | Отправлено: 23:08 04-05-2013 | Исправлено: WestGott, 23:17 04-05-2013 |
|
