CRAZYTRADER Forex : MT4 Indicators
' This workbook
'' TEST ThisWorkBook 24 07 2020 ''
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
'Option Explicit
Public GV_Commande_CMD As Integer
'Public OuvertureAuto As Integer
Public Path_Template As String
Public Path_Source As String
Public Name_TemplateFileYYYYMMDD As String
Public Name_TemplateFile As String
Public Name_SourceFile As String
'Public Path_Attachment As String
'End Var Public
Private Sub Workbook_Open()
'https://www.developpez.net/forums/d814361/logiciels/microsoft-office/general-vba/passage-parametres-macro-ligne-commande/
'http://jpcheck.developpez.com/tutoriels/office/excel-et-fichiers-batch-passage-parametres/#LIII
Dim Chemin As String, NomFichier As String
Dim Chemin1 As String, NomFichier1 As String
'Prompt Emailing
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
'Déclaration des valeurs - Variables globales (Public)
Path_Template = Sheets("PilotageCtrlAuto").Range("K2").Value '"P:\Test\"
Path_Source = Sheets("PilotageCtrlAuto").Range("K3").Value '"P:\Test\SourceFileAM\"
'Nom du fichier de contrôle
Name_TemplateFileYYYYMMDD = Sheets("PilotageCtrlAuto").Range("K1").Value '
'FileName_YYYYMMDD_ = InStr(Name_TemplateFileYYYYMMDD, " -") + 1
FileName_YYYYMMDD = Mid(Name_TemplateFileYYYYMMDD, InStr(Name_TemplateFileYYYYMMDD, " -"))
Name_TemplateFile = Format(Now, "yyyymmdd") & FileName_YYYYMMDD 'K1 Name
'MsgBox Name_TemplateFile
'Nom du fichier Source (report AM)
Name_SourceFileYYYYMMDD = Sheets("PilotageCtrlAuto").Range("A18").Value '
'FileName_YYYYMMDD_ = InStr(Name_SourceFileYYYYMMDD, " -") + 1
FileName_YYYYMMDD = Mid(Name_SourceFileYYYYMMDD, InStr(Name_SourceFileYYYYMMDD, "_"))
Name_SourceFile = Format(Now, "yyyymmdd") & FileName_YYYYMMDD 'A18 Name
'MsgBox Name_SourceFile
Dim CommandLine As String 'Ligne de Commande
Dim OuvertureAuto As Integer
'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
CommandLine = GetCmd 'Lire la ligne de Commande
'pour info
'MsgBox CommandLine
CommandLine = Replace(CommandLine, ThisWorkbook.FullName, "")
' "/dde" est récupéré lorsque l'ouverture du fichier est manuelle
OuvertureAuto = InStr(CommandLine, "/dde") + 1 'Si Ouverture via commande CMD alors OuvertureAuto = 1
'MsgBox OuvertureAuto
'Si Ouverture Manuelle... GV_Commande_CMD = 0
If OuvertureAuto <> 1 And Sheets("PilotageCtrlAuto").Range("C14").Value = "Yes" Then
GV_Commande_CMD = 0
MsgBox "File has been opened manually." & Chr(13) + Chr(10) & _
"Control can be fully executed automatically?" & Chr(13) + Chr(10) & _
"Provided by : ISEC-ISS"
End If
'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
'Effacer les données:
Sheets("PilotageCtrlAuto").Activate
If Sheets("PilotageCtrlAuto").Range("C14").Value = "Yes" Then
'Reset for each run
Range("D6").Value = ""
Range("H17").Value = ""
Range("I17").Value = ""
Range("H18").Value = ""
Range("I18").Value = ""
Range("H19").Value = ""
Range("I19").Value = ""
Range("H20").Value = ""
Range("I20").Value = ""
Range("J20").Value = ""
End If
'Actualisation des Données ODBC externes
If Sheets("PilotageCtrlAuto").Range("C23").Value = "Yes" Then
Call Update_RCP
Call Update_Remotely_unauthorized
'ActiveWorkbook.Connections("RCP users").Refresh
'ActiveWorkbook.Connections("People having to access to applications remotely unauthorized").Refresh
End If
'Sheets("PilotageCtrlAuto").Select
'************
'My Running TEST on Manual Opening
'Call CheckFileExists_RemoteAccessReportYYYMMDD
'*********************
'************************** STARTING CONTROLE AUTO ********************************** PART 1
'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
If OuvertureAuto = 1 And Sheets("PilotageCtrlAuto").Range("C11").Value = "No" And Sheets("PilotageCtrlAuto").Range("C14").Value = "Yes" Then
'If OuvertureAuto <> 1 And Sheets("PilotageCtrlAuto").Range("C11").Value = "No" Then ' for testing
'Si Ouverture via commande CMD alors GV_Commande_CMD = 1
GV_Commande_CMD = OuvertureAuto
'MsgBox "Ouverture Auto " & GV_Commande_CMD
Sheets("PilotageCtrlAuto").Activate
'Effacer les données:
'Reset for each run
Range("D6").Value = ""
Range("H17").Value = ""
Range("I17").Value = ""
Range("H18").Value = ""
Range("I18").Value = ""
Range("H19").Value = ""
Range("I19").Value = ""
Range("H20").Value = ""
Range("I20").Value = ""
Range("J20").Value = ""
'Modify "Starting full process @Opening"
If Range("C11").Value = "No" Then
Range("C11").Value = "Yes"
End If
'Set Date ouverture de fichier
Range("C17") = "Last Opened Time Auto File @ "
Range("D17") = Now
'Actualisation des Données ODBC externes
If Sheets("PilotageCtrlAuto").Range("C23").Value = "Yes" Then
Call Update_RCP
Call Update_Remotely_unauthorized
'ActiveWorkbook.Connections("RCP users").Refresh
'ActiveWorkbook.Connections("People having to access to applications remotely unauthorized").Refresh
End If
'Sheets("PilotageCtrlAuto").Activate
'Enregistrer fichier de controle à la date du jour à partir du fichier de template qui a été ouvert par Outlook.
'ControlDate = Format(Range("D17"), "yyyymmdd")
'Chemin = "P:\Test\"
'NomFichier = ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
'ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
' xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Enregistrer fichier de controle à la date du jour à partir du fichier de template qui a été ouvert par Outlook.
Call CheckFileOfDayExists
'Modify "Starting full process @Opening"
If Range("C11").Value = "Yes" Then
Range("C11").Value = "No"
End If
'Set Date Enregistrement du fichier
Range("C18") = "Last Saved Time Auto File @ "
Range("D18") = Now
Range("C19") = "Elapsed time (Min) : "
'Range("D19") = DateDiff("n", Range("D17"), Range("D18"))
'Bacule sur le fichier Excel template.
'Chemin = "P:\Test\"
' NomFichier = "YYYYMMDD - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
'ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
' xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Bacule sur le fichier Excel template. (C'est surtout qu'on a enregistré le fichier dans le dossier)
'=> Si le fichier du jour a bien été enregistré dans le dossier, alors on enregistre à nouveau le template pour gérer les valeurs dynamiques
CheckTemplateFileExists
'Maintenant on peut Lancer le fichier de contrôle du jour J et le programme va exécuter en auto la partie 2:
ControlDate = Format(Now, "yyyymmdd")
'Chemin1 = "P:\Test\"
Chemin1 = Path_Template
'NomFichier1 = ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
NomFichier1 = Name_TemplateFile
Workbooks.Open Filename:=Chemin1 & NomFichier1
'ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
End If
'************************** STARTING CONTROLE AUTO ********************************* PART 2
If OuvertureAuto = 1 And Sheets("PilotageCtrlAuto").Range("C11").Value = "Yes" Then
'If OuvertureAuto <> 1 And Sheets("PilotageCtrlAuto").Range("C11").Value = "Yes" Then ' for testing
'Actualisation de la deuxième base de Données ODBC externes
'If Sheets("PilotageCtrlAuto").Range("C23").Value = "Yes" Then
'ActiveWorkbook.Connections("RCP users").Refresh
'ActiveWorkbook.Connections("People having to access to applications remotely unauthorized").Refresh
'End If
'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
'Modify "Starting full process @Opening"
Range("C11").Value = "No" 'On force de nouveau la valeur à non
'Modify "Template value"
Range("C14").Value = "No" 'On force la valeur à non pour le template
'Modify "External Data"
Range("C23").Value = "No" 'On force de nouveau la valeur à No
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
' Here we call all the macro
'MsgBox "Full Auto Macro can be launched... It has to be developped!"
''''' ******************************************************** MACRO qui remplace les étapes manuelles
Call CheckFileExists_RemoteAccessReportYYYMMDD
'' --> Qui lance lui même Call UpdateSheetsFromSourceFile
'' Si le fichier existe
''''' ********************************************************
''''' ******************************************************** MACRO 1
If Sheets("PilotageCtrlAuto").Range("D2").Value = "Yes" Then
MsgBox "Macro 1 is ready to start"
Application.Run "Module1.GenererRapport"
'Time to save
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Else
MsgBox "Macro 1 will not start"
End If
''''' ******************************************************** MACRO 2
If Sheets("PilotageCtrlAuto").Range("D3").Value = "Yes" Then
MsgBox "Macro 2 is ready to start"
Application.Run "Module1.GenerationMailingsList"
'Time to save
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Else
MsgBox "Macro 2 will not start"
End If
''''' ******************************************************** MACRO 3
If Sheets("PilotageCtrlAuto").Range("D4").Value = "Yes" Then
MsgBox "Macro 3 is ready to start"
Application.Run "Module7.FileByFileName"
'Application.Run "Module7.DecouperFichier_v1"
Else
MsgBox "Macro 3 will not start"
End If
'Time to save
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
''''' ******************************************************** MACRO 4
If Sheets("PilotageCtrlAuto").Range("D5").Value = "No" Then
MsgBox "Macro 4 will not start"
End If
If Sheets("PilotageCtrlAuto").Range("D5").Value = "Yes" Then
'***** Prompt
Msg = "Do you want to send automatically emails ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Make your choice" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
'MyString = "Yes" ' Perform some action.
'Range("D6").Value = "Yes"
MsgBox "Macro 4 is about to send automaticaly emails"
Application.Run "Module8.CreateHTMLMail_Send"
Application.Run "Module8.SendEmail_JOB_SUCCESSFULLY"
Else ' User chose No.
'MyString = "No" ' Perform some action.
'Range("D6").Value = "No"
MsgBox "Macro 4 is about to display emails only"
Application.Run "Module8.CreateHTMLMail_Display"
End If
'End prompt
End If
''''' ********************************************************
' Enregistrement et cloture du fichier du Jour
'Set Date Enregistrement du fichier
Sheets("PilotageCtrlAuto").Activate
Range("C18") = "Last Saved Time Auto File @ "
Range("D18") = Now
Range("C19") = "Elapsed time (Min) : "
Range("D19") = DateDiff("n", Range("D17"), Range("D18"))
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
ActiveWorkbook.Close 'On cloture Le fichier de contrôle du jour
End If
' Enregistrement et cloture du fichier Template
' Enregistrement et cloture du fichier du Jour
'Set Date Enregistrement du fichier
If OuvertureAuto = 1 Then
Sheets("PilotageCtrlAuto").Activate
Range("C18") = "Last Saved Time Auto File @ "
Range("D18") = Now
Range("C19") = "Elapsed time (Min) : "
Range("D19") = DateDiff("n", Range("D17"), Range("D18"))
'On force des valeurs à No pour le prochain lancement
'Modify "Starting full process @Opening"
Range("C11").Value = "No" 'On force de nouveau la valeur à non
'Modify "Launch Macro Email last step "
Range("D5").Value = "No" 'On force la valeur à non
End If
If OuvertureAuto = 1 Then
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
End If
'Mise à jour de l'affichage
Application.ScreenUpdating = True
'ActiveWorkbook.Close 'On cloture Le fichier de contrôle du jour
'Application.Quit ' Quit Excel
End Sub
'CALLING MACRO
Private Sub CheckFileOfDayExists()
Dim strFileName As String
Dim strFileExists As String
'Enregistrer fichier de controle à la date du jour à partir du fichier de template qui a été ouvert par Outlook.
'ControlDate = Format(Now, "yyyymmdd")
'MsgBox Path_Template
'strFileName = Sheets("PilotageCtrlAuto").Range("K2").Value & ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
strFileName = Path_Template & Name_TemplateFile
strFileExists = Dir(strFileName)
If strFileExists = "" Then
'MsgBox "The selected file doesn't exist" 'Car c'est la première fois qu'on lance le contrôle du jour
'Chemin = "P:\Test\" 'Path (Source file)
Chemin = Path_Template 'Path (Source file)
'NomFichier = ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
NomFichier = Name_TemplateFile
ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
'MsgBox "The selected file exists" 'Dans le cas ou on lance plusieurs fois le contrôle du J
' Don't show confirmation window
Application.DisplayAlerts = False
'Chemin = "P:\Test\" 'Path (Source file)
Chemin = Path_Template 'Path (Source file)
'NomFichier = ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
NomFichier = Name_TemplateFile
ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End If
End Sub
Private Sub CheckTemplateFileExists()
Dim strFileName As String
Dim strFileExists As String
'MsgBox Name_TemplateFile 'ca marche : )
'Enregistrer fichier de controle à la date du jour à partir du fichier de template qui a été ouvert par Outlook.
ControlDate = Format(Now, "yyyymmdd")
'strFileName = Path_Template & ControlDate & " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
strFileName = Path_Template & Name_TemplateFile
strFileExists = Dir(strFileName)
If strFileExists = "" Then
MsgBox "The file Control of the day & ControlDate & doesn't exist" 'Cela ne doit pas arriver!
Else
'MsgBox "The selected file exists"
' Don't show confirmation window
Application.DisplayAlerts = False
Chemin = Path_Template
'NomFichier = "YYYYMMDD - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
NomFichier = Name_TemplateFileYYYYMMDD ' C'est ici qu'on enregistre sur le TEMPLATE
ThisWorkbook.SaveAs Chemin & NomFichier, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End If
End Sub
'Macro standard : On va vérifier que le fichier reçu par email est bien présent dans le bon répertoire
Private Sub CheckFileExists_RemoteAccessReportYYYMMDD()
Dim strFileName As String
Dim strFileExists As String
ControlDate = Format(Now, "yyyymmdd")
'strChemin = "P:\Test\"
strChemin = Path_Source 'Name_SourceFile
'strFileName = "Remote Access Report - CACIB_" & ControlDate & "am.xlsx"
strFileName = Name_SourceFile
strFileExists = Dir(strChemin & strFileName)
' Don't show confirmation window
Application.DisplayAlerts = False
If strFileExists = "" Then
' error 1
MsgBox "The Source File " & strFileName & " doesn't exist"
'Exit Sub
Application.Run "Module5.SendEmail_ERROR_JOB"
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Quit
Else
MsgBox "The Source File " & strFileName & " exists... we can keep going"
Call UpdateSheetsFromSourceFile
End If
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
'Macro Copier les onglets nécessaires pour la mise à jour du controle
Private Sub UpdateSheetsFromSourceFile()
FichierControle = ActiveWorkbook.Name
Call OuvrirFile1
FichierSource1 = ActiveWorkbook.Name
'On va rename l'onglet du fichier AM
'ActiveSheet.Name = "test"
'ActiveSheet.Name = Sheets("PilotageCtrlAuto").Range("A2").Value 'Sheet to be updated
' Don't show confirmation window
Application.DisplayAlerts = False
Workbooks(FichierControle).Activate
Sheets("PilotageCtrlAuto").Select
Range("A16").Select
Selection.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A1").Select
For i = 2 To LastRow
Workbooks(FichierControle).Activate
Sheets("PilotageCtrlAuto").Select
SheetNameTobecopied = Cells(i, 1)
Test1 = FichierControle
Test2 = FichierSource1
'Test si la feuille "Source" existe:
feuilleExiste = False
For f = Workbooks(FichierSource1).Sheets.Count To 1 Step -1
'If Workbooks(FichierSource1).Sheets(f).Name = SheetNameTobecopied Then
If Workbooks(FichierSource1).Sheets.Count = 1 Then
feuilleExiste = True
End If
Next f
If feuilleExiste Then
'Copier Onglet:
'Workbooks(FichierSource1).Sheets(SheetNameTobecopied).Copy Before:=Workbooks(FichierControle).Sheets("PilotageCtrlAuto")
Workbooks(FichierSource1).Sheets(1).Copy Before:=Workbooks(FichierControle).Sheets("PilotageCtrlAuto")
End If
'Rename Sheet
ActiveSheet.Name = Sheets("PilotageCtrlAuto").Range("A2").Value & " (2)" 'Renommer la feuille copiée
'Workbooks(FichierSource1).Sheets("Movis EMEA").Copy Before:=Workbooks(FichierControle).Sheets("PilotageCtrlAuto")
'Workbooks(FichierSource1).Sheets(SheetNameTobecopied).Copy Before:=Workbooks(FichierControle).Sheets("PilotageCtrlAuto")
'Range("A1").Select
Next i
Workbooks(FichierSource1).Activate
ActiveWorkbook.Close
'******** Etape 2 après avoir copié les feuilles sources existantes
'On lance les macros pour updater avec les valeur du jours dans les onglets correspondants
Sheets("PilotageCtrlAuto").Select
Range("A16").Select
Selection.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A1").Select
For i = 2 To LastRow
Sheets("PilotageCtrlAuto").Select
SheetNameTobecopied = Cells(i, 1) & " (2)"
'Après la première boucle il faut revenir sur onglet de Pilotage
Sheets("PilotageCtrlAuto").Activate
'Range("A1").Select
'Test si la feuille "NomAppli" existe:
feuilleExiste = False
For f = ThisWorkbook.Sheets.Count To 1 Step -1
If ThisWorkbook.Sheets(f).Name = SheetNameTobecopied Then
feuilleExiste = True
End If
Next f
If feuilleExiste Then
'Lancer les macros d'update si feuille existante:
If SheetNameTobecopied = Sheets("PilotageCtrlAuto").Range("A2").Value & " (2)" Then
Application.Run "Module4.RemoteAccessReport_Update_AM" ' Call your macro
'ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
End If
'If SheetNameTobecopied = "Pulse EMEA (2)" Then
' Application.Run "Module4.RemoteAccessReport_Update_Pulse_EMEA" ' Call your macro
'ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
'End If
'If SheetNameTobecopied = "Pulse Group (2)" Then
' Application.Run "Module4.RemoteAccessReport_Update_Pulse_Group" ' Call your macro
'ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
'End If
End If
Next i
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
'Macro Ouvrir un fichier Excel
Private Sub OuvrirFile1()
Dim Chemin As String, NomFichier As String
ControlDate = Format(Now, "yyyymmdd")
'Ici je n'ai pas implementé la mécanique du Mid & Instr
'SourceFile = "Remote Access Report - CACIB_" & ControlDate & "am.xlsx"
SourceFile = Name_SourceFile
Chemin = Path_Source
'NomFichier = "Remote Access Report - CACIB_" & ControlDate & "am.xlsx"
NomFichier = SourceFile
Workbooks.Open Filename:=Chemin & NomFichier
End Sub
Private Sub Update_RCP()
'
' Macro1 Macro
'
'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
Sheets("RCP-person").Select
Range("A1").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Sheets("PilotageCtrlAuto").Activate
'Active la mise à jour de l'affichage
Application.ScreenUpdating = True
End Sub
Private Sub Update_Remotely_unauthorized()
'
' Macro1 Macro
' 'Désactive la mise à jour de l'affichage
Application.ScreenUpdating = False
Sheets("Remotely unauthorized").Select
Range("A1").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Sheets("PilotageCtrlAuto").Activate
'Insérer une page de loading?
'Active la mise à jour de l'affichage
'Application.ScreenUpdating = True
End Sub
'Macro standard : Tester si un fichier existe
Private Sub CheckFileExists()
Dim strFileName As String
Dim strFileExists As String
strFileName = "P:\Test\20200724 - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
strFileExists = Dir(strFileName)
If strFileExists = "" Then
MsgBox "The selected file doesn't exist"
Else
MsgBox "The selected file exists"
End If
End Sub
'fonction disponible sur microsoft.public.vb.winapi
Private Function GetCmd() As String
Dim lpCmd As Long
lpCmd = GetCommandLine()
GetCmd = Space$(lstrlen(ByVal lpCmd))
lstrcpy ByVal GetCmd, ByVal lpCmd
End Function
'Module1
Sub GenererRapport()
'
' Macro Flo
'
Dim ReportSheetName As String
ReportSheetName = "Findings"
Dim MOVISEMEASheetLastRow As Integer
Dim PulseEMEASheetLastRow As Integer
Dim PulseGroupSheetLastRow As Integer
Dim FindingSheetLastRow As Integer
Dim UtCodeColumnHeader As String
Dim UserNameColumnHeader As String
Dim BusinessLineColumnHeader As String
Dim ProductLineColumnHeader As String
Dim EntityColumnHeader As String
Dim CountryColumnHeader As String
Dim UserEmailColumnHeader As String
Dim UserContractTypeColumnHeader As String
Dim UserCOSEDomainColumnHeader As String
Dim UserCostCenterColumnHeader As String
Dim UtcodeManagerColumnHeader As String
Dim ManagerNameColumnHeader As String
Dim ToxicColumnHeader As String
Dim ProfileTypeColumnHeader As String
Dim UserBusinessline As String
Dim UserEntity As String
Dim UserCoseDomain As String
Dim UserProductLine As String
Dim BusinesslineColumn As String
Dim EntityColumn As String
Dim CoseDomainColumn As String
Dim ProductLineColumn As String
UtCodeColumnHeader = "UT code"
UserNameColumnHeader = "User"
BusinessLineColumnHeader = "Business Line"
ProductLineColumnHeader = "Product Line"
EntityColumnHeader = "Entity "
CountryColumnHeader = "Country"
UserEmailColumnHeader = "User Email"
UserContractTypeColumnHeader = "User type"
UserCOSEDomainColumnHeader = "COSE Domain"
UserCostCenterColumnHeader = "CostCenter"
UtcodeManagerColumnHeader = "Manager's UT code"
ManagerNameColumnHeader = "Manager's name"
ToxicColumnHeader = "Has access to remotely unauth app"
ProfileTypeColumnHeader = "Connection type"
' Don't show confirmation window
Application.DisplayAlerts = False
'Check STEPS
Sheets("PilotageCtrlAuto").Range("H17").Value = "Yes"
'Added code by BG
'Test si la feuille "Findings" existe:
feuilleExiste = False
For f = ThisWorkbook.Sheets.Count To 1 Step -1
If ThisWorkbook.Sheets(f).Name = "Findings" Then
feuilleExiste = True
End If
Next f
If feuilleExiste Then
Sheets(ReportSheetName).Delete
End If
'Code remplacé
'On supprime l'ancienne feuille Finding
'If Sheets(ReportSheetName) Is Nothing Then
'La feuille a déjà été supprimée
'Else
'Sheets(ReportSheetName).Delete
'End If
'End code BG
'On récupère le nombre de ligne du tableau
Sheets("ReportAM").Select 'Added by BG
Range("A65530").Select
Selection.End(xlUp).Select
ReportAMLastRow = ActiveCell.Row
'On sélectionne le contenu à copier
Range("A1:B" & ReportAMLastRow).Select
'On copie les lignes
Selection.Copy
'Création d'un nouvel onglet
'Sheets.Add After:=ActiveSheet
Sheets.Add After:=ThisWorkbook.Sheets("PilotageCtrlAuto") 'By BG
ActiveSheet.Name = ReportSheetName
'On copie le contenu sur la feuille de l'on vient de créer
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'ActiveSheet.Paste
'Last row = ?
Sheets(ReportSheetName).Range("A65530").Select
Selection.End(xlUp).Select
FindingSheetLastRow = ActiveCell.Row
'**************** Finalisation ****************
'Ajout des nouvelles colonnes
Range("C1") = "Day"
Range("D1") = ProfileTypeColumnHeader
Range("E1") = UtCodeColumnHeader
Range("F1") = UserNameColumnHeader
Range("G1") = BusinessLineColumnHeader
Range("H1") = ProductLineColumnHeader
Range("I1") = UserCostCenterColumnHeader
Range("J1") = EntityColumnHeader
Range("K1") = CountryColumnHeader
Range("L1") = UserCOSEDomainColumnHeader
Range("M1") = UserContractTypeColumnHeader
Range("N1") = UserEmailColumnHeader
Range("O1") = UtcodeManagerColumnHeader
Range("P1") = ManagerNameColumnHeader
Range("Q1") = ToxicColumnHeader
Range("R1") = "Filename"
'Remplissage colonne Day
Range("C2").Select
ActiveCell.FormulaR1C1 = "=DATE(YEAR(ControlDay!R6C3),MONTH(ControlDay!R6C3),DAY(ControlDay!R6C3))+TIME(HOUR(ControlDay!R6C3)+3,MINUTE(ControlDay!R6C3),SECOND(ControlDay!R6C3))"
Range("C2").Select
Selection.NumberFormat = "dd/mm/yyyy hh:mm:ss"
Selection.Copy
Range("C2:C" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage Connection type
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],ProfileType!R2C1:R40C2,2,FALSE)"
Range("D2").Select
Selection.Copy
Range("D2:D" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column UT code
Range("E2").Select
ActiveCell.FormulaR1C1 = "=UPPER(LEFT(RC[-4],6))"
Range("E2").Select
Selection.Copy
Range("E2:E" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column User name
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Tableau_RCP_export,2,FALSE)"
Range("F2").Select
Selection.Copy
Range("F2:F" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Business Line
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Tableau_RCP_export,3,FALSE)"
Range("G2").Select
Selection.Copy
Range("G2:G" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Product Line
Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Tableau_RCP_export,4,FALSE)"
Range("H2").Select
Selection.Copy
Range("H2:H" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Cost Center
Range("I2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],Tableau_RCP_export,13,FALSE)"
Range("I2").Select
Selection.Copy
Range("I2:I" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Entity
Range("J2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Tableau_RCP_export,5,FALSE)"
Range("J2").Select
Selection.Copy
Range("J2:J" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Country
Range("K2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Tableau_RCP_export,8,FALSE)"
Range("K2").Select
Selection.Copy
Range("K2:K" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column COSE domain
Range("L2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],Tableau_RCP_export,11,FALSE)"
Range("L2").Select
Selection.Copy
Range("L2:L" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Contract type
Range("M2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],Tableau_RCP_export,6,FALSE)"
Range("M2").Select
Selection.Copy
Range("M2:M" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column User email
Range("N2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],Tableau_RCP_export,7,FALSE)"
Range("N2").Select
Selection.Copy
Range("N2:N" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Managet UT code
Range("O2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-10],Tableau_RCP_export,14,FALSE)"
Range("O2").Select
Selection.Copy
Range("O2:O" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage column Manager name
Range("P2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-11],Tableau_RCP_export,15,FALSE)"
Range("P2").Select
Selection.Copy
Range("P2:P" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Remplissage de la column Accès Interdit à distance
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-13]=""Full"",IF(ISERROR(VLOOKUP(RC[-12],Tableau_PeopleHaveAuthRemotelyUnauh,3,FALSE)),""No"",""Yes""),""No"")"
Range("Q2").Select
Selection.Copy
Range("Q2:Q" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Code added by BG
' Error Message ???
'Checking error 3
If Sheets("PilotageCtrlAuto").Range("G11").Value = "Yes" Then
Application.Run "Module5.ErrorMessage_MacroFindings"
End If
'End code by BG
'Remplissage de la colonne qui donne le nom du fichier pour découpage
BusinesslineColumn = "G" 'F"
EntityColumn = "J"
CoseDomainColumn = "L"
ProductLineColumn = "H"
For i = 2 To FindingSheetLastRow
UserBusinessline = Range(BusinesslineColumn & i).Value
UserEntity = Range(EntityColumn & i).Value
UserCoseDomain = Range(CoseDomainColumn & i).Value
UserProductLine = Range(ProductLineColumn & i).Value
Select Case UserEntity
Case "CA-CIB France"
Select Case Left(UserBusinessline, 3)
Case ""
Range("R" & i).Value = "Je suis là"
Select Case UserCoseDomain
Case "GIT"
Range("R" & i).Value = "CA-CIB France - GIT"
Case "LEGAL"
Range("R" & i).Value = "CA-CIB France - LGL"
Case "COM"
Range("R" & i).Value = "CA-CIB France - CSE"
Case "GSP"
Range("R" & i).Value = "CA-CIB France - CSE"
Case "CMO"
Range("R" & i).Value = "CA-CIB France - OPC"
Case "GRM"
Range("R" & i).Value = "CA-CIB France - OPC"
Case "FTO"
Range("R" & i).Value = "CA-CIB France - OPC"
Case "GMO"
Range("R" & i).Value = "CA-CIB France - OPC"
Case Else
Range("R" & i).Value = "CA-CIB France - " & Left(UserCoseDomain, 3)
End Select
'
Case "DEX"
If UserCoseDomain = "PDG" Then
Range("R" & i).Value = "CA-CIB France - PDG"
Else
Range("R" & i).Value = "CA-CIB France - " & UserCoseDomain
End If
Case "GIT"
If UserProductLine = "GIT - ISS Information Systems & Security" Then
Range("R" & i).Value = "CA-CIB France - ISS"
ElseIf UserProductLine = "GIT - Project Sector" Then
Range("R" & i).Value = "CA-CIB France - FP"
Else
Range("R" & i).Value = "CA-CIB France - " & Left(UserCoseDomain, 3)
End If
Case Else
Range("R" & i).Value = "CA-CIB France - " & Left(UserBusinessline, 3)
End Select
Case ""
Range("R" & i).Value = "Tobedefined"
'Rattachement de FIS à GIT
Case "FIS"
Range("R" & i).Value = "CA-CIB France - GIT"
'Rattachement de GENPACT à GIT
Case "GENPACT"
Range("R" & i).Value = "CA-CIB France - GIT"
Case "ACCENTURE"
Range("R" & i).Value = "CA-CIB France - GIT"
Case "CA-CIB New York Branch"
Range("R" & i).Value = "CA-CIB Americas"
Case "CA Indosuez (Switzerland) S.A."
Range("R" & i).Value = "CA Indosuez (Switzerland)"
Case "Credit Agricole CIB AO"
Range("R" & i).Value = "CA-CIB Russia"
Case "CA America Services Inc."
Range("R" & i).Value = "CA-CIB Americas"
Case "CA Indosuez Wealth (Brazil) S.A. DTVM"
Range("R" & i).Value = "CA Indosuez Wealth (Brazil)"
Case "CA-CIB Houston Rep. Office"
Range("R" & i).Value = "CA-CIB Americas"
Case "CA Securities (USA) Inc."
Range("R" & i).Value = "CA-CIB Americas"
Case "CA Indosuez Finanziaria S.A."
Range("R" & i).Value = "CA Indosuez Finanziaria"
Case "CA-CIB Norway Rep. Office"
Range("R" & i).Value = "CA-CIB Nordics"
Case "CA-CIB Greece Rep. Office"
Range("R" & i).Value = "CA-CIB Greece Rep Office"
Case "CA-CIB Mexico Rep. Office"
Range("R" & i).Value = "CA-CIB Mexico Rep Office"
Case "CA-CIB Jakarta Rep. Office"
Range("R" & i).Value = "CA-CIB Jakarta Rep Office"
Case "CA-CIB Argentina Rep. Office"
Range("R" & i).Value = "CA-CIB Argentina Rep Office"
Case "CALYON SECUR.USA"
Range("R" & i).Value = "CA-CIB Americas"
Case "CA Indosuez Wealth (Uruguay) Ser. & Rep. S.A."
Range("R" & i).Value = "CA Indosuez Wealth (Uruguay)"
Case "CALYON Rep.Off Israel"
Range("R" & i).Value = "CA-CIB RepOff Israel"
Case "CA-CIB Austria Rep. Office"
Range("R" & i).Value = "CA-CIB Austria Rep Office"
Case "CA-CIB Shenzhen Rep. Office"
Range("R" & i).Value = "CA-CIB China"
Case "CA-CIB Colombia Rep. Office"
Range("R" & i).Value = "CA-CIB Colombia Rep Office"
Case "CA-CIB Helsinki Branch"
Range("R" & i).Value = "CA-CIB Nordics"
Case "CA-CIB Sweden Branch"
Range("R" & i).Value = "CA-CIB Nordics"
'Mine
Case "CA Indosuez (Suisse) S.A. Hong Kong Branch"
Range("R" & i).Value = "CA Indosuez (Suisse) Hong Kong Branch"
Case "CA Indosuez (Suisse) S.A. Singapore Branch"
Range("R" & i).Value = "CA Indosuez (Suisse) Singapore Branch"
Case "CA-CIB Chile Rep. Office"
Range("R" & i).Value = "CA-CIB Chile Rep Office"
'Dans RCP, les utilisateurs de Singapore Branch et ISAP sont dans la même entité.
Case "CA-CIB Singapore Branch"
If UserCoseDomain = "SINGAPORE" Then
Range("R" & i).Value = "CA-CIB Singapore Branch"
Else
Range("R" & i).Value = "ISAP"
End If
Case Else
Range("R" & i).Value = UserEntity
End Select
Next i
'------------------ Fin remplissage colonne ------------------ '
'Suppression des formules
Range("A1:R" & FindingSheetLastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
'Réorganisation des colonnes
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
'New cvode by BG
Sheets("ReportAM").Select
Range("C65530").Select
Selection.End(xlUp).Select
LastRow = ActiveCell.Row
'On sélectionne le contenu à copier
Range("C1:G" & LastRow).Select
'On copie les lignes
Selection.Copy
Sheets(ReportSheetName).Select
Range("R1").Select
'On copie le contenu sur la feuille de l'on vient de créer
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'End New code
' Gestion du Local Time
Range("W1").Value = "Add/remove"
Range("X1").Value = "Hours"
Range("Y1").Value = "Minutes"
Range("Z1").Value = "sessionConnectedLocalTime"
Range("AA1").Value = "sessionLogoffLocalTime"
Range("W2").Select
'Add/remove
Range("W2").Select
'LookupCol_3 =
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-13],'GMT time zone'!R3C1:R100C5,3,FALSE)"
'Hours
Range("X2").Select
'LookupCol_4 =
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-14],'GMT time zone'!R3C1:R100C5,4,FALSE)"
'Minutes
Range("Y2").Select
'LookupCol_5 =
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-15],'GMT time zone'!R3C1:R100C5,5,FALSE)"
'Etendre la formule sur la colonne
Range("W2").Select
Selection.Copy
Range("W2:W" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Etendre la formule sur la colonne
Range("X2").Select
Selection.Copy
Range("X2:X" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Etendre la formule sur la colonne
Range("Y2").Select
Selection.Copy
Range("Y2:Y" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Suppression des formules
Range("W2:Y" & FindingSheetLastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'sessionConnectedLocalTime
Range("Z2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]=""N/A"",""N/A"",IF(RC[-3]=""Add"",RC[-6]+TIME(RC[-2],RC[-1],0),RC[-6]-TIME(RC[-2],RC[-1],0)))"
'"=IF(RC[-3]=""Add"",RC[-6]+TIME(RC[-2],RC[-1],0),RC[-6]-TIME(RC[-2],RC[-1],0))"
'sessionLogoffLocalTime
Range("AA2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]=""N/A"",""N/A"",IF(RC[-4]=""Add"",RC[-6]+TIME(RC[-3],RC[-2],0),RC[-6]-TIME(RC[-3],RC[-2],0)))"
'"=IF(RC[-4]=""Add"",RC[-6]+TIME(RC[-3],RC[-2],0),RC[-6]-TIME(RC[-3],RC[-2],0))"
'Etendre la formule sur la colonne
Range("Z2").Select
Selection.Copy
Range("Z2:Z" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Etendre la formule sur la colonne
Range("AA2").Select
Selection.Copy
Range("AA2:AA" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Suppression des formules
Range("Z2:AA" & FindingSheetLastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'' Vérificatioin des anomalies dans le listing
Range("AB1").Value = "Check Ano"
Range("AB2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R[0]C[-2]=""N/A"",R[0]C[-1]=""N/A""),""Ano"",IF(AND(DAY(R[0]C[-2])=DAY(TODAY()-1),DAY(R[0]C[-1])=DAY(TODAY()-1)),""OK"",""Ano""))"
'Etendre la formule sur la colonne
Selection.Copy
Range("AB2:AB" & FindingSheetLastRow).Select
ActiveSheet.Paste
'Suppression des formules
Range("AB2:AB" & FindingSheetLastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Range("A1").Select
'On va supprimer les lignes qui ne sont pas en anomalies !
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
For i = DernLigne To 2 Step -1
'Gestion des Ano
If Cells(i, 28) = "OK" Then
Test = Cells(i, 28)
Rows(i).Delete
End If
'--------
Next i
'On supprime colonne W qui ne sert plus à rien... La valeur est toukours "Ano"
Columns("AB:AB").Delete
Range("A1").Select
'Ajout de la fonction Filtre
Range("D1").Select
Selection.AutoFilter
'Time format
Columns("T:U").Select
Selection.NumberFormat = "yyyy/mm/dd hh:mm"
Columns("Z:AA").Select
Selection.NumberFormat = "yyyy/mm/dd hh:mm"
'On supprime colonne intermédiare de calcul (time zone)
Columns("W:Y").Delete
'On supprime les 2 colonnes en GMT
Columns("T:U").Delete
'Cosmétique des entêtes de column... Q now V
Range("A1:V1").Select
Range("V1").Activate
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:S1").EntireColumn.AutoFit
'Centrage de certaines columns
Columns("A:E").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("I:V").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'tri du tableau
Range("A1:V" & FindingSheetLastRow).Select
ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort.SortFields.Add Key:= _
Range("R2:R" & FindingSheetLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort.SortFields.Add Key:= _
Range("Q2:Q" & FindingSheetLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort.SortFields.Add Key:= _
Range("F2:F" & FindingSheetLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort.SortFields.Add Key:= _
Range("G2:G" & FindingSheetLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Findings").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'On ne garde que les profils FULL'
'ActiveSheet.Range("$A$1:$Q$" & FindingSheetLastRow).AutoFilter Field:=3, Criteria1:= _
' "=Standard", Operator:=xlOr, Criteria2:="=Unknown"
'Rows("2:2").Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Delete Shift:=xlUp
'ActiveSheet.Range("$A$1:$Q$" & FindingSheetLastRow).AutoFilter Field:=3
'Resizing de la fenêtre à 90%
ActiveWindow.Zoom = 90
'Positionnement sur la cellule A1
Range("A1").Select
'Check STEPS End
Sheets("PilotageCtrlAuto").Range("I17").Value = "Yes"
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
Sub GenerationMailingsList()
Dim LastRowIndex As Integer
Dim Path_Files_Attached As String
Dim ControlDate As String
Dim i As Integer
Dim ReportSheetName As String
ReportSheetName = "Findings"
' Don't show confirmation window
Application.DisplayAlerts = False
'Check STEPS
Sheets("PilotageCtrlAuto").Range("H18").Value = "Yes"
'Added code by BG
'Sheets("MailingList").Select 'Added by BG
'Test si la feuille "Findings" existe:
feuilleExiste = False
For f = ThisWorkbook.Sheets.Count To 1 Step -1
If ThisWorkbook.Sheets(f).Name = "MailingList" Then
feuilleExiste = True
End If
Next f
If feuilleExiste Then
Sheets("MailingList").Delete
End If
'Code remplacé
'On supprime l'ancienne feuille Finding
'If Sheets("MailingList") Is Nothing Then
'A revoir ca la macro plante si la feuille n'existe pas.
' i = 1
'Else
' Sheets("MailingList").Delete
'End If
'End BG
Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K4").Value 'Path_Files_Attached
'Path_Files_Attached = "P:\Test\FichierCut\"
'Path_Files_Attached = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\"
Sheets(ReportSheetName).Select
'Récupération de la date de la journée contrôlée
ControlDate = Format(Range("A2"), "yyyymmdd")
Columns("Q:Q").Select
Selection.Copy
Sheets.Add After:=ThisWorkbook.Sheets(ReportSheetName) 'By BG
'Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "MailingList"
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A65530").Select
Selection.End(xlUp).Select
LastRowIndex = ActiveCell.Row
ActiveSheet.Range("$A$1:$A$" & LastRowIndex).RemoveDuplicates Columns:=1, Header:=xlYes
'On récupère le nouveau nombre de lignes
Range("A65530").Select
Selection.End(xlUp).Select
LastRowIndex = ActiveCell.Row
'Création des nouvelles colonnes
Range("B1") = "Day"
Range("C1") = "From"
Range("D1") = "To"
Range("E1") = "CC"
Range("F1") = "Subject"
Range("G1") = "PJ1"
Range("H1") = "PJ2"
Range("I1") = "PJ3"
Range("J1") = "Body"
'Remplissage colonne Day
Range("B2").Select
ActiveCell.FormulaR1C1 = "=DATE(YEAR(ControlDay!R6C3),MONTH(ControlDay!R6C3),DAY(ControlDay!R6C3))"
Range("B2").Select
Selection.NumberFormat = "yyyymmdd"
Selection.Copy
Range("B2:B" & LastRowIndex).Select
ActiveSheet.Paste
'Remplissage colonne From
Range("C2").Select
ActiveCell.FormulaR1C1 = "ISEC-ISS-Controls@ca-cib.com"
Range("C2").Select
Selection.Copy
Range("C2:C" & LastRowIndex).Select
ActiveSheet.Paste
'Remplissage colonne To
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],EmailTemplate!C[-3]:C[-2],2,FALSE)"
Range("D2").Select
Selection.Copy
Range("D2:D" & LastRowIndex).Select
ActiveSheet.Paste
'Remplissage colonne CC
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],EmailTemplate!C[-4]:C[-2],3,FALSE)"
Range("E2").Select
Selection.Copy
Range("E2:E" & LastRowIndex).Select
ActiveSheet.Paste
'Remplissage colonne Subject
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],EmailTemplate!C[-5]:C[-1],4,FALSE)"
Range("F2").Select
Selection.Copy
Range("F2:F" & LastRowIndex).Select
ActiveSheet.Paste
'Remplissage colonne PJ1
For i = 2 To LastRowIndex
AttachmentName = Path_Files_Attached & ControlDate & " - " & Range("A" & i) & ".xlsx"
Range("G" & i).Value = AttachmentName
Next i
'Remplissage colonne body
Range("J2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],EmailTemplate!C[-9]:C[-5],5,FALSE)"
Range("J2").Select
Selection.Copy
Range("J2:J" & LastRowIndex).Select
ActiveSheet.Paste
'For i = 2 To LastRowIndex
' AttachmentName = Path_Files_Attached & ControlDate & " - " & Range("A" & i) & ".xlsx"
' Range("G" & i).Value = AttachmentName
' Next i
'Suppression des formules
Range("A1:J" & LastRowIndex).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
' Error Message ???
'Code added by BG
'Checking error 2
If Sheets("PilotageCtrlAuto").Range("G11").Value = "Yes" Then
Application.Run "Module5.ErrorMessage_MacroMailing"
End If
'End code by BG
'Code by BG
'Réorganisation des colonnes
Columns("A:A").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Columns("K:K").Paste
'Réorganisation des colonnes
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'End Code by BG
'Ajout de la fonction Filtre
Range("A1").Select
Selection.AutoFilter
'Cosmétique des entêtes de column
Range("A1:H1").Select
Range("H1").Activate
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Cosmétiques laegeur de colonnes
Columns("A:A").ColumnWidth = 30.5
Columns("B:B").ColumnWidth = 81.5
Columns("C:C").ColumnWidth = 30.5
Columns("D:D").ColumnWidth = 75.5
Columns("E:E").ColumnWidth = 50.5
'Check STEPS End
Sheets("PilotageCtrlAuto").Range("I18").Value = "Yes"
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
'Module4
Private Sub RemoteAccessReport_Update_AM()
'MsgBox ("test macro : Update AM")
' Don't show confirmation window
Application.DisplayAlerts = False
Sheet_Name = Sheets("PilotageCtrlAuto").Range("A2").Value
'Clear data ReportAM
'Sheet_Name = Sheets("PilotageCtrlAuto").Range("A2").Value
Sheets(Sheet_Name).Select
Columns("A:G").Delete
Sheets(Sheet_Name & " (2)").Select
Test_Colonne_7 = Range("G1").Value
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Coller data ???? remettre A1 cellule quand le fichier cvs a 7 colonnes
Sheets(Sheet_Name).Select
If Test_Colonne_7 = "" Then 'On a encore que 6 colonnes... App code is missed alors on colle en B1
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
Range("A1").Select 'Sinon... on se place en A1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
'********************************
'Prévoir La gestion du cvs
'Time format
'Columns("C:D").Select
'Selection.NumberFormat = "yyyy/mm/dd hh:mm"
'********************************
'User
'Columns("H:H").Copy
'Columns("A:A").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Application.CutCopyMode = False
'Role
'Columns("D:D").Copy
'Columns("B:B").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Application.CutCopyMode = False
'Range("B1").Value = "Role"
'Rows(2).Delete
'Cosmétique des entêtes de column
Range("A1:G1").Select
'Range("H1").Activate
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Préparation des colonnnes A et B pour coller les data dans findings
Columns("E:E").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
'Columns("C:C").Select
'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' A supprimer ou vérifier le code avec le tableau
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
For i = DernLigne To 2 Step -1
'Gestion de UT ccode et liste d'exclusion
'Supprimer les lignes moisies du fichier source... UT Code = ( UNKNOWN )
If Len(Cells(i, 1)) > 6 Or Cells(i, 1) = "UNKNOWN" Or Cells(i, 1) = "SEKAR DINAKARAN (UNIX ADMIN)" Or Cells(i, 1) = "UT2QZEUT2QZF" Then
' PULSE-ASIA-EQX PULSE-ASIA-NCS
Rows(i).Delete
End If
'--------
Next i
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
For i = DernLigne To 2 Step -1
'Gestion de AppCode
If Cells(i, 3) = "" Then
Cells(i, 3) = "Unknown for now!"
End If
'--------
Next i
'Entete
If Range("C1") = "" Then
Range("C1").Value = "AppCode"
End If
'Time format
Columns("E:F").Select
Selection.NumberFormat = "yyyy/mm/dd hh:mm"
Range("A1").Select
'On supprime la feuille temporaire
Sheets(Sheet_Name & " (2)").Delete
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
Private Sub RemoteAccessReport_Update_Pulse_EMEA()
'MsgBox ("test macro : Update Pulse_EMEA")
' Don't show confirmation window
Application.DisplayAlerts = False
'Clear data
Sheets("Pulse EMEA").Select
Columns("A:B").ClearContents
Sheets("Pulse EMEA (2)").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Coller data
Sheets("Pulse EMEA").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Columns("D:L").Delete
Columns("B:B").Delete
'Supprimer les lignes
Range("A65530").Select
Selection.End(xlUp).Select
LastRowIndex = ActiveCell.Row
Range("A1").Select
For i = 2 To LastRowIndex
If Cells(i, 2) = ".Administrators" Then
Rows(i).EntireRow.Delete
End If
Next i
'On supprime la feuille temporaire
Sheets("Pulse EMEA (2)").Delete
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
Private Sub RemoteAccessReport_Update_Pulse_Group()
'MsgBox ("test macro : Update Pulse_Group")
' Don't show confirmation window
Application.DisplayAlerts = False
'Clear data
Sheets("Pulse Group").Select
Columns("A:B").ClearContents
Sheets("Pulse Group (2)").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Coller data
Sheets("Pulse Group").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Columns("D:L").Delete
Columns("B:B").Delete
'On supprime la feuille temporaire
Sheets("Pulse Group (2)").Delete
' Allow confirmation windows to appear as normal
Application.DisplayAlerts = True
End Sub
'Module5
'Gestion des erreurs
'# Error :
'# Error1 Le fichier source (reçu par email / ou déposer dans un répertoire spécifique) n'existe pas dans le répertoire //.....SourceFile
'# Error2 Il y a un nouveau FileName à compléter dans la feuille TemplateEmail car une personne fait référence à une entité inconnue (CA-CIB-xxx,...)
'# Error3 UT Code from Source est inconnue dans RCP-person (table de référence)
'# Error1
' Gérer directement lors de l'appel du fichier source dans TW
Private Sub SendEmail_ERROR_JOB()
'Creates a new email item and modifies its properties
Dim objMail As Outlook.MailItem
Dim Ligne As Integer
Dim DernLigne As Integer
Dim Path_EmailTemplate As String
Dim Name_TemplateEmail As String
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail = Sheets("PilotageCtrlAuto").Range("K8").Value 'Name_TemplateEmail
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail)
With objMail
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = "isec-iss-controls@ca-cib.com"
.To = "baptiste.george-prestataire@ca-cib.com"
'.CC = Range("C" & Ligne)
.Subject = "[Job Status : Remote Control AM]"
'source_file = Range("E" & Ligne)
'.Attachments.Add source_file
.Send
'.Body = "Daily control starts automaticaly for MOVIS PULSE EMEA 3AM. Source File (xlxs) from Emails on SharedInbox 'ISEC-ISS' will be stored into folder 'SourceFileAM'"
End With
End Sub
'# Error2
Private Sub ErrorMessage_MacroMailing() 'macro appelé par Macro 2 Mailing (Module1)
Sheets("MailingList").Select
Range("A65530").Select
Selection.End(xlUp).Select
LastRowIndex = ActiveCell.Row
Range("A1").Select
For i = 2 To LastRowIndex
If WorksheetFunction.IsNA(Cells(i, 4)) Then
'MsgBox ("Test NA, Macro will stop")
' Error Message ???
Error_value = Cells(i, 1)
MsgBox ("The value '" & Error_value & "' for FileName missed into 'EmailTemplate' Sheet")
'Ici qu'il faut gérer le NO pour la macro 2.
'Exit Sub
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
End ' La macro prend fin
Else
If Cells(i, 5) = 0 Then
Cells(i, 5).Value = ""
End If
End If
Next i
End Sub
'# Error3
Private Sub ErrorMessage_MacroFindings() 'macro appelé par Macro 1 Findings (Module1)
Sheets("Findings").Select
Range("A65530").Select
Selection.End(xlUp).Select
LastRowIndex = ActiveCell.Row
Range("A1").Select
For i = 2 To LastRowIndex
If WorksheetFunction.IsNA(Cells(i, 6)) Then
'MsgBox ("Test N/A")
' Error Message ???
Error_value = Cells(i, 5)
MsgBox ("The value '" & Error_value & "' for UT code missed into 'RCP-Person' Sheet")
'Ici qu'il faut gérer le NO pour la macro 2.
'Exit Sub
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
End ' La macro prend fin
End If
Next i
End Sub
'Module7
Private Sub FileByFileName()
Dim Path_Files_Attached As String
' Don't show confirmation window
Application.DisplayAlerts = False
'Check STEPS
Sheets("PilotageCtrlAuto").Range("H19").Value = "Yes"
'FichierControle = Active.Worbook
FichierControle = ActiveWorkbook.Name
Sheets("MailingList").Activate
Range("A1").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To DernLigne
'MyCurrentFileName = ActiveCell.Value
MyCurrentFileName = Cells(i, 9).Value
'Désactivation du filtre auto
If Sheets("Findings").AutoFilterMode Then
Sheets("Findings").AutoFilterMode = False
End If
'Filtre avec la colonne I de Sheets("MailingList")
Sheets("Findings").Range("A1").AutoFilter Field:=17, Criteria1:=MyCurrentFileName, Operator:=xlFilterValues
'Récupération de la date de la journée contrôlée
ControlDate = Format(Now, "yyyymmdd")
' créer le fichier + sauvegarde du fichier
'Path_Files_Attached = "P:\Test\FichierCut\"
Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K4").Value 'Path_Files_Attached
NomDuFichier = Path_Files_Attached & ControlDate & " - " & MyCurrentFileName ' mettre dans une variable le chemin du fichier afin que la personne mette ce quil veut
Workbooks.Add.SaveAs Filename:=NomDuFichier
FileName_i = ActiveWorkbook.Name
' Copier Onglet:
Workbooks(FichierControle).Sheets("Findings").Copy Before:=Workbooks(FileName_i).Sheets("Feuil1")
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Coller data
Sheets("Feuil1").Select
ActiveSheet.Paste
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
'Application.CutCopyMode = False
'Cosmétiques laegeur de colonnes
Columns("A:P").EntireColumn.AutoFit
' Suppression de colonne
Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets(1).Delete
'Time to save
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
ActiveWorkbook.Close
Next i
Sheets("Findings").Select
'Désactivation du filtre auto
If Sheets("Findings").AutoFilterMode Then
Sheets("Findings").AutoFilterMode = False
End If
Sheets("MailingList").Select
' Suppression de colonne
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
'Check STEPS end
Sheets("PilotageCtrlAuto").Range("I19").Value = "Yes"
' Show confirmation window
Application.DisplayAlerts = True
End Sub
'Module8
Private Sub CreateHTMLMail_Display()
'Creates a new email item and modifies its properties
Sheets("MailingList").Select
Dim objMail As Outlook.MailItem
Dim Ligne As Integer
Dim DernLigne As Integer
Dim Path_EmailTemplate As String
Dim Name_TemplateEmail As String
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail = Sheets("PilotageCtrlAuto").Range("K6").Value 'Name_TemplateEmail
'Check STEPS
Sheets("PilotageCtrlAuto").Range("H20").Value = "Yes"
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'Create email item
For Ligne = 2 To DernLigne
'Set objMail = Outlook.CreateItemFromTemplate("\\smb11-nas1.par.emea.cib\UT2XJJ\HomeDir17\Test\FichierCut\EmailTemplate.msg")
'Set objMail = Outlook.CreateItemFromTemplate("\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\Setting\EmailTemplate.msg")
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail)
With objMail
'.Attachments.Add "\Script-Génération-mails.vbs"
'Set body format to HTML
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = Range("A" & Ligne)
.To = Range("B" & Ligne)
.CC = Range("C" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Range("E" & Ligne)
.Attachments.Add source_file
.Display
End With
Next Ligne
'Check STEPS End
Sheets("PilotageCtrlAuto").Range("I20").Value = "Yes"
Sheets("PilotageCtrlAuto").Range("J20").Value = DernLigne - 1 & " emails have been displayed @ " & Format(Now, "yyyy-mm-dd hh:mm:ss")
End Sub
Private Sub CreateHTMLMail_Send()
'Creates a new email item and modifies its properties
Sheets("MailingList").Select
Dim objMail As Outlook.MailItem
Dim Ligne As Integer
Dim DernLigne As Integer
Dim Path_EmailTemplate As String
Dim Name_TemplateEmail As String
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail = Sheets("PilotageCtrlAuto").Range("K6").Value 'Name_TemplateEmail
'Check STEPS
Sheets("PilotageCtrlAuto").Range("H20").Value = "Yes"
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'Create email item
For Ligne = 2 To DernLigne
'Set objMail = Outlook.CreateItemFromTemplate("\\smb11-nas1.par.emea.cib\UT2XJJ\HomeDir17\Test\FichierCut\EmailTemplate.msg")
'Set objMail = Outlook.CreateItemFromTemplate("\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\Setting\EmailTemplate.msg")
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail)
With objMail
'.Attachments.Add "\Script-Génération-mails.vbs"
'Set body format to HTML
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = Range("A" & Ligne)
.To = Range("B" & Ligne)
.CC = Range("C" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Range("E" & Ligne)
.Attachments.Add source_file
.Send
End With
Next Ligne
'Check STEPS End
Sheets("PilotageCtrlAuto").Range("I20").Value = "Yes"
Sheets("PilotageCtrlAuto").Range("J20").Value = DernLigne - 1 & " emails have been sent @ " & Format(Now, "yyyy-mm-dd hh:mm:ss")
End Sub
Private Sub SendEmail_JOB_SUCCESSFULLY()
'Creates a new email item and modifies its properties
Dim objMail As Outlook.MailItem
Dim Ligne As Integer
Dim DernLigne As Integer
Dim Path_EmailTemplate As String
Dim Name_TemplateEmail As String
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail = Sheets("PilotageCtrlAuto").Range("K7").Value 'Name_TemplateEmail
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail)
With objMail
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = "isec-iss-controls@ca-cib.com"
.To = "isec-iss-controls@ca-cib.com"
'.CC = Range("C" & Ligne)
.Subject = "[Job Status : Remote Control AM]"
'source_file = Range("E" & Ligne)
'.Attachments.Add source_file
.Send
'.Body = "Daily control starts automaticaly for MOVIS PULSE EMEA 3AM. Source File (xlxs) from Emails on SharedInbox 'ISEC-ISS' will be stored into folder 'SourceFileAM'"
End With
End Sub