Yeah
It works great. Every time a mail which is under a rule, incomes, mail is tidied in the correct sub-folder and saved by the script executed by rule
But now i have another challenge...
This deals with attached file. I'm specialy interrested by two type of mails :
- Nornofolio Details
- Plassit Rice
I'm adding two rules in Outlook because besides saving mail on network, i need to extract attached file too.
Code:
'----------------------Règle 8-------------------------------------------------------------------------------------------------------
Sub rule_ExtractCP(Mail As Outlook.MailItem)
FundType = "Tlassic Rice"
Call ExtractCP(Mail, "H:\XXX\99. DWH\EXTRACTION\Tlassic Rice\", FundType)
End Sub
with
Sub ExtractCP(MyMail As Outlook.MailItem, repertoire, FundType)
End Sub
and
Code:
Sub ExtractPD(MyMail As Outlook.MailItem, repertoire, FundType)
End Sub
with
'----------------------Règle 9-------------------------------------------------------------------------------------------------------
Sub rule_ExtractPD(Mail As Outlook.MailItem)
FundType = "Portfolio Details"
Call ExtractCP(Mail, "H:\XXX\99. DWH\EXTRACTION\Nornolio Details\", FundType)
End Sub
I already have a macro which is working perfectly. Aim of this macro is too seek into "Extraction" Outlook sub-folder for mails. For each of mails found, Macro opens attached file, read and copy A2 cell information and paste it in the Excel file of Macro. At the end, macro use pasted cell to create name of file on network.
I did it because i need to name my files with information took into attached file...
This is the code :
Macro is in a module of an Excel file named "Extraction - Browser.xlsm"
Code:
Sub RetrieveMailFiles_Click()
Dim MonOutlook As Outlook.Application
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim Mypath As String
Dim i As Integer
Dim dtDate As Date
Dim sDate As String
Dim sName2 As String
Dim sName3 As String
Dim Inbox2 As MAPIFolder
Dim Inbox3 As MAPIFolder
Dim Td As Date
Dim Rd As Date
Dim Nd As String
Dim awb As Workbook
Dim aws As Worksheet
Set ns = GetNamespace("MAPI")
Set InboxFold = ns.GetFolderFromID("00000000CA5063795BBABA4E85B7BB93FA4923A901001D2C09AE1B48E742934DA9D063E6543B000000E6E19D0000")
Set awb = ActiveWorkbook
Set aws = awb.ActiveSheet
Dim d As String
Application.ScreenUpdating = False
For Each Item In InboxFold.Items
For Each Atmt In Item.Attachments
'-----------------------------------------------------/ AAA /----------------------------------------
If Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" And Item.Body Like "*AAA*" Then
'Creation of a Temp file "datefile" which is a pasting of attached file
FileName = "H:\XXX\99. DWH\EXTRACTION\datefile.xls"
Atmt.SaveAsFile FileName
Workbooks.Open FileName
'Copy of "A2" cell whichi is.....
Range("A2").Select
Selection.Copy
'Pasting data from A2 to B2 in "Extraction - Browser.xlsm"
Windows("Extraction - Browser.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Opening of "datefile"
FileName = "H:\BSI ManCo\Control Function\99. DWH\EXTRACTION\datefile.xls"
Workbooks.Open FileName
'Copy of E2
Range("E2").Select
Selection.Copy
'Pasting of E2 in B3 in "Extraction - Browser.xlsm"
Windows("Extraction - Browser.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Closing of "datefile..xls"
Workbooks("datefile.xls").Close
Kill FileName
'Final File Creation
Windows("Extraction - Browser.xlsm").Activate
ActiveWorkbook.Save
sDate = aws.Range("D2").Value
sName2 = aws.Range("D3").Value
sName3 = aws.Range("B4").Value
FileName = "H:\99. DWH\EXTRACTION\" & sDate & " - " & sName2 & " - " & sName3 & ".xls"
Atmt.SaveAsFile FileName
Item.UnRead = False
'-----------------------------------------------------------------/ BBB /----------------------------------------
ElseIf Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" And Item.Body Like "*
'-----------------------------------------------------------------/ CCC/-----------------------------------------
ElseIf Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" And Item.Body Like "*
'-----------------------------------------------------------------/ DDD/----------------------------------------
ElseIf Item.UnRead = False And Right(Atmt.FileName, 3) = "xls" And Item.Body Like "*
End If
'Next Attachment in same mail
Next Atmt
'Next Email
Next Item
'Kill FileName
If InboxFold.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Multichallenge Globes Inbox"
End If
End Sub
Well...both macro are perfectly working but i have to find a way to adapt second one in Outlook. For now the part
Code:
Set InboxFold = ns.GetFolderFromID("00000000CA5063795BBABA4E85B7BB93FA4923A901001D2C09AE1B48E742934DA9D063E6543B000000E6E19D0000")
does not suit with because i'm not extracting mails in Outlook but mails in Windows browser !