#######################################################
# Script Schedule Report 3 AM
#
# Gestion du control 3 AM cadencé par PowerShell
#
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Recertification\Control_Remote3AM.ps1
#
####################################################### -- ###### Provided by Baptiste GEORGE ######
# # # # # # Step 1 : Saving Attachements from Excel on Outlook + Email sent to alert for starting process
$excel= new-object -comobject excel.application
$excel.Visible = $false
$excel.DisplayAlerts = $false
$xlm = [Microsoft.Office.Interop.Excel.XlFileFormat]::xlOpenXMLWorkbookMacroEnabled
$PathFile = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\Settings\SendingEmail_Paris Remote Access Report.xlsm"
$classeur=$excel.workbooks.open($PathFile)
# Exécution de la macro
$excel.Run('Starting_Process')
$excel.Workbooks.Close()
$excel.Quit()
get-process *excel* | stop-process -force # Kill Excel Session
# # # # # # Step 2 : Ouverture du fichier de template du control et déclenchement auto à l'ouverture d'Excel
$excel= new-object -comobject excel.application
$excel.Visible = $false
$excel.DisplayAlerts = $false
$PathFile = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\YYYYMMDD - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
$classeur=$excel.workbooks.open($PathFile)
# $excel.ActiveWorkbook.SaveAs($PathFile,$xlm)
# $excel.Workbooks.Close()
$excel.Quit()
get-process *excel* | stop-process -force
# # # # # # Step 3 : Classer les fichiers
# Step 3.1 : TEST L'existence d'un dossier... Sinon, Création du dossier à la date du Jour
$today = (Get-Date -Format yyyyMMdd)
#$folder = "P:\Test\Powershell\" + "$Today"
$folder = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\" + "$Today" + "\"
if (!(test-path -path $folder)) {new-item -path $folder -itemtype directory}
# Step 3.2 : Déplacer les fichiers des remédiations dans le dossier du jour créer à cet effet
# On supprime les fichiers du jour s'ils existent.
Get-ChildItem $folder*.xlsx -file -r | remove-item
# Step 3.3 : Déplacer les fichiers :
$Chemin = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\"
Move-Item -Path $Chemin"*.xlsx" -Destination $folder
# # # # # # Step 4 : Déplacer les fichiers xlsx du jour dans Archivage
$folder = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\Archivage\ASIA EMEA UK\"
$Chemin = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\"
$folderFile = "$folder" + "Remote Access Report - CACIB_" + "$today" + "am.xlsx"
# Step 4.1 : Avant : On vérifie si le fichier fusinné existe, si oui... on supprime.
If (Test-Path $folderFile){
Remove-Item $folderFile
}
# Step 4.2 : Déplacer les fichiers :
Move-Item -Path $Chemin"*.xlsx" -Destination $folder
# # # # # # Step 5 : On renomme le fichier de controle du jour pour les applications APPcode traités... ici ASIA EMEA UK
$Chemin1 = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\"
$FileTtemp = " - BG - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
$today = (Get-Date -Format yyyyMMdd)
$folderFileTemp = $Chemin1 + "$today" + $FileTtemp
$OutputFile = "$today" + " - MOVIS PULSE EMEA CACIB connections out of biz hours with Mail.xlsm"
$Path_OutputFile = "$Chemin1" + "$OutputFile"
# Step 5.1 : Avant : On vérifie si le fichier existe, si oui... on supprime.
If (Test-Path $Path_OutputFile){
Remove-Item $Path_OutputFile
}
# Step 5.2 : # Rename-Item -Path $folderFileTemp -NewName "new_20200918 - PULSE ASIA EMEA UK connections out of biz hours with Mail.txt"
Rename-Item -Path $folderFileTemp -NewName $OutputFile
#######################################################
# Script PowerShell - Remote Control 3AM AMERICA
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Fusion_DailyUsage_SourceAM_AMERICA_csv.ps1
#
# https://blog.netwrix.com/2018/05/17/powershell-file-management/
#
####################################################### -- ###### Provided by Baptiste GEORGE ######
#Parameters
$Chemin = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\"
$Chemin_NameFile = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\MERGED_Remote_Access_ReportAM.csv"
# # # # # # Step 1 : Saving Attachements from Excel on Outlook + Email sent to alert for starting process
$excel= new-object -comobject excel.application
$excel.Visible = $false
$excel.DisplayAlerts = $false
$classeur=$excel.workbooks.open("\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\Settings\SendingEmail_AM_AMERICA.xlsm")
# Exécution de la macro
$excel.Run('Starting_Process')
$excel.Workbooks.Close()
$excel.Quit()
get-process *excel* | stop-process -force # Kill Excel Session
# # # # # # Step 2 : On vérifie si le fichier remote en date du jour existe, si oui... on supprime
$today = (Get-Date -Format yyyyMMdd)
$FileName = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\" + "$today" + "_Remote_Access_ReportAM.csv"
If (Test-Path $FileName){
Remove-Item $FileName
}
# Step 2.1 : Filtrant les fichiers moins d'une x heure(s)... créant un fichier MERGED_Remote_Access_ReportAM.csv
Get-Childitem -Path $Chemin*.csv | where { !($_.CreationTime -lt (get-Date).AddHours(-10))} | ForEach-Object {
Import-Csv $_.FullName
# } |Select-Object ApplicationCode,SessionConnected,SessionLogoff,UserName,Domain,Profile |Export-Csv -Path "Z:\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\MERGED_Remote_Access_ReportAM.csv" -NoTypeInformation
} |Select-Object appCode,applicationCode,sessionConnectedTimeInGMT,sessionLogoffTimeInGMT,userName,Domain,profile |Export-Csv -Path $Chemin_NameFile -NoTypeInformation
# Step 2.2 : On préfixe avec la date YYYYMMDD en remplacant "MERGED" par la date du jour -> Soit YYYYMMDD_Remote_Access_ReportAM.csv
Get-ChildItem -path $Chemin -recurse -include @("*.csv") | rename-item -newname { $_.name -replace "MERGED",$(get-date -Format yyyyMMdd)}
# # # # # # Step 3 : Lancer le fichier de Contrôle
$excel= new-object -comobject excel.application
$excel.Visible = $true
$excel.DisplayAlerts = $false
$classeur=$excel.workbooks.open("\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\YYYYMMDD - AUTO - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm")
$excel.Workbooks.Close()
$excel.Quit()
get-process *excel* | stop-process -force # Kill Excel Session
# # # # # # Step 4 : On renomme le fichier de controle du jour pour les application Appcode traités... ici AMERICA
$Chemin1 = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\"
$FileTtemp = " - AUTO - MOVIS PULSE EMEA connections out of biz hours with Mail.xlsm"
$today = (Get-Date -Format yyyyMMdd)
$folderFileTemp = $Chemin1 + "$today" + $FileTtemp
$OutputFile = "$today" + " - PULSE AMERICA connections out of biz hours No Mail.xlsm"
# $Path_OutputFile = "$Chemin1" + "$today" + " - PULSE AMERICA connections out of biz hours No Mail.xlsm"
$Path_OutputFile = "$Chemin1" + "$OutputFile"
# Step 4.1 : Avant : On vérifie si le fichier existe, si oui... on supprime.
If (Test-Path $Path_OutputFile){
Remove-Item $Path_OutputFile
}
# Step 4.2 : Rename-Item -Path $folderFileTemp -NewName "new_20200918 - PULSE AMERICA connections out of biz hours with Mail.txt"
Rename-Item -Path $folderFileTemp -NewName $OutputFile
# # # # # # Step 5 : Déplacer les fichiers csv du jour dans Archivage
$Chemin = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\"
$folder = "\\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\91 - Controles Pulse\MOVIS PULSE EMEA Connections out of biz hours\SourceFileAM\Archivage\AMERICA\"
# On supprime les fichiers du jour s'il existe.
$today_ = (Get-Date -Format yyyy-MM-dd)
Get-ChildItem $folder*$today_.csv -file -r | remove-item
$folderFile = "$folder" + "$today" + "_Remote_Access_ReportAM.csv"
# Step 5.1 : Avant : On vérifie si le fichier fusinné existe, si oui... on supprime.
If (Test-Path $folderFile){
Remove-Item $folderFile
}
# Step 5.2 : Déplace les fichiers :
Move-Item -Path $Chemin"*.csv" -Destination $folder
#######################################################
# Script ReCertification
# Step4_Recertif_AnalyzingFiles
# Recertification Liste fichier en retour :
# https://www.tutos.eu/5453
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Recertification\Step4_Recertif_AnalyzingFiles.ps1
#######################################################
# Partie 1
# Compter le nombre de ligne dans un fichier et le nombre de colonne
# http://domeu.blogspot.com/2011/11/powershell-excel-combien-de-rows-dans.html
$EmplacementFichier = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\__LignesParFichier.txt"
$MonFichier = New-Item -type file $EmplacementFichier -Force
$FolderSourceFiles = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\" #__TEST\"
$chemin = "$FolderSourceFiles" + "*.*"
$fichiers = get-childitem $chemin
foreach ($fichier in $fichiers) {
# Open the Excel file
# Write-Host "Ouverture du fichier" -BackgroundColor Yellow
$excel = New-Object -ComObject Excel.Application
$excel.Visible = $false
$excel.DisplayAlerts = $false
$excel.Workbooks.Open( $fichier )
# Write-Host "Extraction des données..." -BackgroundColor Yello
# Nbre de Lignes :
$sheet1 = $excel.Sheets.Item(1)
# Write-Host $sheet.UsedRange.Rows.count
$sheet1calcul1 = $sheet1.UsedRange.Rows.count
$sheet1calcul = $sheet1calcul1 - 1
$sheet2 = $excel.Sheets.Item(2)
# Write-Host $sheet.UsedRange.Rows.count
$sheet2calcul2 = $sheet2.UsedRange.Rows.count
$sheet2calcul = $sheet2calcul2 - 1
# Nbre de colonnes :
# Write-Host $sheet.UsedRange.Columns.count
$sheet1col = $sheet1.UsedRange.Columns.count
$sheet2col = $sheet2.UsedRange.Columns.count
$resultatligne = "$fichier;L_Sheet2;$sheet2calcul;L_Sheet1;$sheet1calcul;C_Sheet2;$sheet2col;C_Sheet1;$sheet1col"
ADD-content -path $MonFichier -value $resultatligne
}
# Kill Excel Session
get-process *excel* | stop-process -force
# Partie 1 PJ
###### TEST
# \\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés
# \\smb15-nas1.par.emea.cib\ISS_DATA\08 - I3C\01 - I3C Applications\07 - MARLY\11 - 2019\08 - Task 6 - Campagne de recertification\99 - Tool box utilisée
$Folder = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Retour\" #__TEST\"
$FolderResultat = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Retour\"
$OutFile = "__ListeFichiersEnRetour.txt"
$FolderOutFile = "$FolderResultat" + "$OutFile"
# Avant : On vérifie si le fichier existe, si oui... on supprime.
If (Test-Path $FolderOutFile){
Remove-Item $FolderOutFile
}
Get-ChildItem -Path $Folder*.xlsx | %{ADD-content -path $FolderOutFile -value $_.FullName}
# Get-ChildItem -Path $Folder | %{ADD-content -path "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\ZZMonfile.txt" -value $_.FullName}
## RENAME FILES QUICKLY ### PJ
# "Copie de "
# "Copy of "
# "Copia de "
# "2020 "
$Text_a_Remplace = "Copie de "
$FolderSourceFiles = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Retour\" #__TEST\"
Get-ChildItem -Path $FolderSourceFiles | rename-item -NewName {$_.name -replace $Text_a_Remplace,""}
#######################################################
# Script ReCertification
# Step5_Recertif_Files_ToBeRemoved
# Recertification Déplacer des fichiers :
#
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Recertification\Step5_Recertif_Files_ToBeRemoved.ps1
#######################################################
# Déplace les fichiers .xlsx qui ont un text = "removed" dans la colonne E de l'onglet 2
$Pathfiles = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\__TEST\"
$Destination = "$Pathfiles" + "To be removed\"
$SearchText = 'removed'
$Excel = New-Object -ComObject Excel.Application
$Files = Get-ChildItem $Pathfiles"*.xlsx" | Select -Expand FullName
$counter = 1
ForEach($File in $Files){
Write-Progress -Activity "Checking: $file" -Status "File $counter of $($files.count)" -PercentComplete ($counter*100/$files.count)
$Workbook = $Excel.Workbooks.Open($File)
If($Workbook.Sheets.Item(2).Range("E:E").Find($SearchText)){
# Pas de text trouvé, on ferme le fichier
$Workbook.Close($false)
# Si le texte recherché est trouvé alors on déplace les fichiers dans un nouveau dossier : )
# Moved $file to $destination"
Move-Item -Path $File -Destination $Destination
break
}
$workbook.close($false)
$counter++
}
' File vbs... Fusion de fichier Excel.
''''''''''''''''''''''''''
' Déclarations
''''''''''''''''''''''''''
' application excel
Dim objExcel
' application excel pour les fichiers à merger
Dim objNewExcel
' classeur excel
Dim objWorkBook
' classeur excel pour les fichiers à merger
Dim objNewWorkbook
' ligne courante dans classeur excel complet
Dim intRow
' ligne courante dans classeur excel pour les fichiers merger
Dim intCurLines
' objet choix de fichier
Dim objDialog
' nombre de fichiers mergés
Dim intMergedFiles
' objet file system pour gérer les fichiers
Dim fso
' répertoire de sortie où sont déposés les fichiers générés
Dim outputFolder
' fichier de sortie
Dim outputFile
' répertoire contenant les fichiers à merger
Dim inputFolder
''''''''''''''''''''''''''
' Traitement
''''''''''''''''''''''''''
msgbox "Lancement du traitement."
on error resume next
' on initialise le nombre de fichiers mergés
intMergedFiles = 0
' récupération du dossier contenant les fichiers à merger
inputFolder = GetInputFolder()
' le choix du dossier est obligatoire
do while ( inputFolder = "" )
inputFolder = GetInputFolder()
loop
' récupération du dossier où déposer le résultat du merge
outputFolder = GetOutputFolder()
' aucun dossier choisi ?
if ( outputFolder = "" ) then
' oui: on utilise le dossier du fichier source
outputFolder = inputFolder
end if
' le nom du fichier de sortie
outputFile = "" & inputbox( "Entrer le nom du fichier généré : " )
if ( outputFile = "" ) then
' oui: on utilise le nom concat
outputFile = "concat"
end if
' on précise l'extension ".xls"
outputFile = outputFile & ".xlsx"
' creation application excel
Set objExcel = CreateObject("Excel.application")
' création application excel des fichiers découpés
Set objNewExcel = CreateObject("Excel.Application")
' ligne courante dans le fichieer mergé
intCurLines = 1
'création du fichier mergé
Set objWorkbook = objExcel.Workbooks.Add
' création de l'objet file system pour le parcourt du répertoire
Set fso = CreateObject("Scripting.FileSystemObject")
' on récupère les fichiers à merger
with fso.GetFolder( inputFolder )
' pour chaque fichier trouvé
For Each nomFichier In .Files
' est-ce un fichier excel ?
if ( right( nomFichier, 5 ) = ".xlsx" ) then
' oui: on doit le traiter
' ouverture fichier excel
Set objNewWorkBook = objNewExcel.Workbooks.Open( inputFolder & "\" & nomFichier.Name )
' on recopie le fichier à partir de la première ligne
intRow = 1
' on parcourt tant qu'il y a une donnée dans la première cellule de la ligne
Do Until objNewExcel.Cells(intRow,1).Value = ""
''''''''''''''''''''''''''''''''
' recopie des données excel
''''''''''''''''''''''''''''''''
' on ajoute la ligne au fichier
i = 1
do while ( objNewWorkbook.Worksheets(1).Cells( 1 , i) <> "" )
objWorkbook.Worksheets(1).Cells(intCurLines , i) = objNewWorkbook.Worksheets(1).Cells(intRow , i)
i = i + 1
loop
' est-ce la première ligne du fichier ?
if ( intRow = 1 ) then
' oui: on doit recopier les styles
i = 1
do while ( objNewWorkbook.Worksheets(1).Cells( 1 , i) <> "" )
' on met la même largeur de colonne
objWorkbook.Worksheets(1).Columns(i).ColumnWidth = objNewWorkbook.Worksheets(1).Columns(i).ColumnWidth
' on recopie tous les styles
objWorkbook.Worksheets(1).Cells(intCurLines , i).Interior.ColorIndex = objNewWorkbook.Worksheets(1).Cells(1 , i).Interior.ColorIndex
objWorkbook.Worksheets(1).Cells(intCurLines , i).Interior.Pattern = objNewWorkbook.Worksheets(1).Cells(1 , i).Interior.Pattern
objWorkbook.Worksheets(1).Cells(intCurLines , i).Interior.PatternColorIndex = objNewWorkbook.Worksheets(1).Cells(1 , i).Interior.PatternColorIndex
objWorkbook.Worksheets(1).Cells(intCurLines , i).HorizontalAlignment = objNewWorkbook.Worksheets(1).Cells(1 , i).HorizontalAlignment
objWorkbook.Worksheets(1).Cells(intCurLines , i).VerticalAlignment = objNewWorkbook.Worksheets(1).Cells(1 , i).VerticalAlignment
objWorkbook.Worksheets(1).Cells(intCurLines , i).WrapText = objNewWorkbook.Worksheets(1).Cells(1 , i).WrapText
objWorkbook.Worksheets(1).Cells(intCurLines , i).Orientation = objNewWorkbook.Worksheets(1).Cells(1 , i).Orientation
objWorkbook.Worksheets(1).Cells(intCurLines , i).AddIndent = objNewWorkbook.Worksheets(1).Cells(1 , i).AddIndent
objWorkbook.Worksheets(1).Cells(intCurLines , i).IndentLevel = objNewWorkbook.Worksheets(1).Cells(1 , i).IndentLevel
objWorkbook.Worksheets(1).Cells(intCurLines , i).ShrinkToFit = objNewWorkbook.Worksheets(1).Cells(1 , i).ShrinkToFit
objWorkbook.Worksheets(1).Cells(intCurLines , i).ReadingOrder = objNewWorkbook.Worksheets(1).Cells(1 , i).ReadingOrder
objWorkbook.Worksheets(1).Cells(intCurLines , i).MergeCells = objNewWorkbook.Worksheets(1).Cells(1 , i).MergeCells
objWorkbook.Worksheets(1).Cells(intCurLines , i).Font.ColorIndex = objNewWorkbook.Worksheets(1).Cells(1 , i).Font.ColorIndex
objWorkbook.Worksheets(1).Cells(intCurLines , i).Font.Bold = objNewWorkbook.Worksheets(1).Cells(1 , i).Font.Bold
i = i + 1
loop
end if
' on incrémente le nombre de lignes mergées
intCurLines = intCurLines + 1
' on continue de parcourir le classeur excel
intRow = intRow + 1
Loop
' fermeture classeur excel
objNewWorkBook.Close False
' liberation objet classeur excel
Set objNewWorkBook = Nothing
' on incrémente le nombre de fichiers mergés
intMergedFiles = intMergedFiles + 1
end if
Next
end with
' au moins un fichier mergé ?
if ( intMergedFiles >= 1 ) then
' oui: on sauvegarde le fichier
' sauvegarde fichier mergé
objWorkbook.SaveAs outputFolder & "\" & outputFile
end if
' fermeture fichier mergé
objWorkbook.Close
' libération fichier mergé
Set objWorkbook = Nothing
'''''''''''''''''''''''''''''''''
' Libération des ressources
'''''''''''''''''''''''''''''''''
' liberation objet file system
Set fso = Nothing
' liberation objet application excel pour les fichiers à merger
Set objNewExcel = Nothing
' liberation objet application excel
Set objExcel = Nothing
'''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''
' Rapport de fin de traitemet
'''''''''''''''''''''''''''''''''
msgbox "Traitement terminé : " & intMergedFiles & " fichier(s) regroupé(s)"
'''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''
' Fonction de choix d'un dossier
'''''''''''''''''''''''''''''''''
Function GetInputFolder()
' objet shell
Dim objShell
' objet dossier
Dim objFolder
' init du shell
set objShell = CreateObject("Shell.Application")
' affichage fenêtre de choix de dossier
set objFolder = objShell.BrowseForFolder(0, "Merci de choisir le dossier contenant les fichiers à regrouper.", 0, 0)
' un dossier a-t-il été choisi ?
if (not objFolder is nothing) then
' oui: on peut extraire le chemin du dossier
GetInputFolder = objFolder.ParentFolder.ParseName(objFolder.Title).Path
end if
' libération objet dossier
set objFolder = nothing
' libération objet shell
set objShell = nothing
End Function
'''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''
' Fonction de choix d'un dossier
'''''''''''''''''''''''''''''''''
Function GetOutputFolder()
' objet shell
Dim objShell
' objet dossier
Dim objFolder
' init du shell
set objShell = CreateObject("Shell.Application")
' affichage fenêtre de choix de dossier
set objFolder = objShell.BrowseForFolder(0, "Merci de choisir le dossier où déposer le fichier généré.", 0, 0)
' un dossier a-t-il été choisi ?
if (not objFolder is nothing) then
' oui: on peut extraire le chemin du dossier
GetOutputFolder = objFolder.ParentFolder.ParseName(objFolder.Title).Path
end if
' libération objet dossier
set objFolder = nothing
' libération objet shell
set objShell = nothing
End Function
'''''''''''''''''''''''''''''''''
'Fusion de fichiers Excel (choix de la feuille)
Private Sub fusionclasseur()
'https://forum.excel-pratique.com/excel/fusion-de-fichiers-xlsx-en-un-seul-sans-la-premiere-ligne-51017#p283994
Set wbf = ThisWorkbook ' wbf reférence le classeur maitre
Set wsc = wbf.Worksheets.Add ' on ajoute une feuille dans le classeur maitre
wsc.Name = "Résultat fusion" ' on nomme la feuille " résultat fusion"
'-------------------------------
' on demande du répertoire qui contient les fichiers à fusionner via dialogue windows
' résultat dans chemin
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Sélectionner le répertoire contenant les fichiers à fusionner"
.Filters.Clear
.AllowMultiSelect = False
If .Show = -1 Then ' si un répertoire sélectionné
chemin = .SelectedItems(1) & "\" ' on le met dans chemin
Else
Exit Sub 'pas de répertoire sélectionné, on arrête
End If
End With
'---------------------------------
masque = InputBox("introduire le filtre de sélection des classeurs (défaut *.xls*)") ' masque est le filtre des fichiers à sélectionner
wsn = InputBox("Nom de la feuille à copier de chaque classeur (défaut première feuille trouvée)") ' wsn nom de la feuille à copier de chaque classeur à fusionner
If masque = "" Then masque = "*.xls*" ' si masque est vide on attribue le filtre par défaut
f = Dir(chemin & masque) ' f= nom du premier fichier correspondant au critère
ctrf = 0 ' compteur de classeurs fusionnés
pli = 1 'première ligne sur résultat fusion
While f <> "" ' tant qu'il y a des fichiers(classeurs)) à fusionner
ctrf = ctrf + 1 '
Set wbi = Workbooks.Open(chemin & f) ' on ouvre le classeur
If wbi.Name <> wbf.Name Then ' si classeur différent du classeur maitre
If wsn = "" Then Set wsi = wbi.Worksheets(1) Else Set wsi = wbi.Worksheets(wsn) ' on sélectionne la feuille à fusionner =wsi
dli = wsi.Range("A" & Rows.Count).End(xlUp).Row ' dli dernière ligne sur wsi
If dli > 1 Then
If ctrf = 1 Then pl = 1 Else pl = 2 ' si premier classeur à fusionner, il faut copier l'entête
wsi.Rows(pl & ":" & dli).Copy wsc.Range("a" & pli) 'on copie les lignes du classeur à fusionner dans la feuille résultat de fusion
pli = pli + dli + 1 - pl ' on ajuste le nombre de lignes de résultat fusion
End If
End If
wbi.Close 'on ferme le classeur
f = Dir() 'on passe au classeur suivant
Wend
End Sub
'Découper fichiers'
Sub Recertification_by_BG()
' Don't show confirmation window
Application.DisplayAlerts = False
'En amont
'Check STEPS end
Sheets("PilotageCtrlAuto").Range("E1").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Range("E2").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Range("E3").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Select
Range("E1") = Now
'Macro
Dim Path_Files_Attached As String
' Path_Files_Attached = "P:\Recertification\"
Path_Files_Attached = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\"
'FichierControle = Active.Worbook
FichierControle = ActiveWorkbook.Name
'Colonnes
'Sheets("ISEC-ISS").Select
'A_COLUMN_WIDTH = Range("A1").ColumnWidth
'B_COLUMN_WIDTH = Range("B1").ColumnWidth
'C_COLUMN_WIDTH = Range("C1").ColumnWidth
'D_COLUMN_WIDTH = Range("D1").ColumnWidth
'E_COLUMN_WIDTH = Range("E1").ColumnWidth
'F_COLUMN_WIDTH = Range("F1").ColumnWidth
'G_COLUMN_WIDTH = Range("G1").ColumnWidth
'H_COLUMN_WIDTH = Range("H1").ColumnWidth
'I_COLUMN_WIDTH = Range("I1").ColumnWidth
'FIRST_ROW_HEIGHT = Range("I1").RowHeight
Sheets("PilotageCtrlAuto").Activate
Range("A1").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To DernLigne
'MyCurrentFileName = ActiveCell.Value
MyCurrentFileName = Cells(i, 1).Value
'Désactivation du filtre auto
If Sheets("ISEC-ISS").AutoFilterMode Then
Sheets("ISEC-ISS").AutoFilterMode = False
End If
'Filtre avec la colonne K de Sheets("ISEC-ISS")
Sheets("ISEC-ISS").Range("A1").AutoFilter Field:=11, Criteria1:=MyCurrentFileName, Operator:=xlFilterValues
' créer le fichier + sauvegarde du fichier
'Path_Files_Attached = "P:\Recertification\"
'Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K1").Value 'Path_Files_Attached
'NomDuFichier = Path_Files_Attached & ControlDate & " - " & MyCurrentFileName & " - " & NbreDroits - 1 & ".xlsx" ' mettre dans une variable le chemin du fichier afin que la personne mette ce quil veut"
Workbooks.Add 1 'Filename:=NomDuFichier
'Workbooks.Add.SaveAs Filename:=NomDuFichier
FileName_i = ActiveWorkbook.Name
' Copier Onglet:
Workbooks(FichierControle).Sheets("ISEC-ISS").Copy After:=Workbooks(FileName_i).Sheets("Feuil1")
Workbooks(FichierControle).Sheets("Profiles_description").Copy After:=Workbooks(FileName_i).Sheets("Feuil1")
Sheets("ISEC-ISS").Select
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
Range("A1").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To DernLigne
'Gestion des commentaires
If Cells(j, 4) <> "" Then
If Cells(j, 13) <> "" Then
sComment = Cells(j, 13)
Cells(j, 4).AddComment
Cells(j, 4).Comment.Visible = False
Cells(j, 4).Comment.Text Text:=sComment 'Cells(j, 13) '
Cells(j, 4).Comment.Shape.TextFrame.AutoSize = True
End If
End If
'Ajout de la partie validation -- Full choice
If Cells(j, 4) <> "" Then
Cells(j, 5).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Profiles_description!$M$2:$M$5"
'xlBetween, Formula1:="=choice"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
'Ajout de la partie validation -- Less Choice
Cells(j, 5).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Profiles_description!$L$2:$L$4"
'xlBetween ,Formula1:="=choice2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
Next j
' Suppression de colonne
Columns("J:P").Delete
'Traitement des entêtes
Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 39
Columns("C:C").ColumnWidth = 39
Columns("D:D").ColumnWidth = 39
Columns("E:E").ColumnWidth = 19
Columns("F:F").ColumnWidth = 38
Columns("G:G").ColumnWidth = 38
Columns("H:H").ColumnWidth = 6
Columns("I:I").ColumnWidth = 19
'Traitement de la première ligne du fichier
Rows("1:1").RowHeight = 32
'Cosmétiques largeur de colonnes
Columns("D:D").EntireColumn.AutoFit
'Devérouillage de la cellule pour permettre à l'utilisateur de saisir son choix
Range("A1").Select
NbreDroits = Range("A" & Rows.Count).End(xlUp).Row
Range("E2:E" & NbreDroits).Select
Selection.Locked = False
Selection.FormulaHidden = False
'Verrouillage de la feuille.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowSorting _
:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
'Feuille Profiles_description
Sheets("Profiles_description").Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowSorting _
:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Sheets("Feuil1").Activate
Range("E2").Select
ActiveSheet.Name = "ISS"
'Récupération de la date de la journée contrôlée
'Sheet_Name_Date = Format(Now, "yyyy-MM-dd")
'On renomme la feuille?
'ActiveSheet.Name = Sheet_Name_Date
'Suppression du premier onglet
Sheets(3).Delete
'On réduit la taille à 95%
ActiveWindow.Zoom = 95
' créer le fichier + sauvegarde du fichier
'Récupération de la date de la journée contrôlée
'ControlDate = Format(Now, "yyyy")
'Path_Files_Attached = "P:\Recertification\"
'Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K1").Value 'Path_Files_Attached
NomDuFichier = Path_Files_Attached & MyCurrentFileName & " - " & NbreDroits - 1 & ".xlsx" ' mettre dans une variable le chemin du fichier afin que la personne mette ce quil veut"
'Workbooks.Add 'Filename:=NomDuFichier
'Workbooks.Add.SaveAs Filename:=NomDuFichier
'Save the current workbook
ActiveWorkbook.SaveAs Filename:=NomDuFichier
'Time to save
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
ActiveWorkbook.Close
Next i
'Fin du traitement... retour sur le fichier de recertification :
Sheets("ISEC-ISS").Select
Range("A1").Select
'Désactivation du filtre auto
If Sheets("ISEC-ISS").AutoFilterMode Then
Sheets("ISEC-ISS").AutoFilterMode = False
End If
'End
Sheets("PilotageCtrlAuto").Select
Range("E2") = Now
Range("D3") = "Elapsed time (Min) : "
Range("E3") = DateDiff("n", Range("E1"), Range("E2"))
'Mise à jour de l'affichage
Application.ScreenUpdating = True
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Application.Quit ' Quit Excel
End Sub
'Depuis Excel, Manage Emails on outlook, save attachements, move emails to folder
'Module2:
Sub Recertification_Gestion_Email()
'Initialisation data :
Sheets("PilotageCtrlAuto").Range("D1").Value = ""
Sheets("PilotageCtrlAuto").Range("D2").Value = ""
Sheets("PilotageCtrlAuto").Range("D3").Value = ""
Sheets("PilotageCtrlAuto").Range("D6").Value = ""
Sheets("PilotageCtrlAuto").Select
'Set Date ouverture de fichier
Range("C1") = "Last Opened file @ "
Range("D1") = Now
' Recherche d'email dont l'objet correspond à la campagne de recertification.
'=> Déplacement d'email dans le dossier "Temp" du dossier "23 - Recertification"
Application.Run "Module1.Deplacer_Email_Outlook"
Application.Run "Module1.Deplacer_Email_Outlook" 'Bug... faut lancer deux fois! Ok! ; (
'PJ sauvegarder sur un répertoire bureautique depuis le dossier "temp"
Application.Run "Module1.Email_SaveAttchementsToDisk_Outlook"
'Les emails sans PJ (.xlsx) sont déplacés dans le dossier "Temp_Question"
Application.Run "Module1.Deplacer_Email_Questions_Outlook"
Application.Run "Module1.Deplacer_Email_Questions_Outlook"
'Set Date Enregistrement du fichier
Sheets("PilotageCtrlAuto").Activate
Range("C2") = "Last time file saved @ "
Range("D2") = Now
Range("C3") = "Temps de Traitement (Min) : "
Range("D3") = DateDiff("n", Range("D1"), Range("D2"))
Range("D6") = "Emails from Inbox have been managed !"
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Application.Quit
End Sub
'Module1
'####### STEP 1
Private Sub Deplacer_Email_Outlook()
'https://docs.microsoft.com/fr-fr/office/vba/api/Outlook.Items.Restrict
Dim outlookapp As Object
Dim olNs As Outlook.Namespace
Dim myFldr As Outlook.Folder
Dim objMail As Object
Dim myTasks As Outlook.Items
Dim daysAgo As Long
Dim projIDsearch0 As String
Dim myRecipient As Outlook.Recipient
Dim outMailItem As Outlook.MailItem
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
'Initialisation
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("isec-iss-controls@ca-cib.com")
Param_projIDsearch0 = Sheets("PilotageCtrlAuto").Range("K13").Value
Param_projIDsearch1 = Sheets("PilotageCtrlAuto").Range("K14").Value
Param_daysAgo = Sheets("PilotageCtrlAuto").Range("K15").Value
'Declare Folder Destination to attach files to hard disk
'saveFolder = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Simulation Manager Fichier\Stockage PJ Retour\"
'Check access to Outlook Inbox
myRecipient.Resolve
'Declare Shared Email Inbox
Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
'Declare subject to look for into email on Outlook
projIDsearch0 = Param_projIDsearch0 '"RE: [TEST]"
projIDsearch1 = Param_projIDsearch1 '"RE: [TEST]"
Len_projIDsearch0 = Len(projIDsearch0)
Len_projIDsearch1 = Len(projIDsearch1)
'MsgBox (Len_projIDsearch0)
' Restrict search to daysAgo' daysAgo = 0 => Emails from today only
daysAgo = Param_daysAgo '0
'Restriction on emails to look for :
Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
For Each objMail In myTasks
If (InStr(1, Left(objMail.Subject, Len_projIDsearch0), projIDsearch0, vbTextCompare) > 0 Or InStr(1, Left(objMail.Subject, Len_projIDsearch1), projIDsearch1, vbTextCompare) > 0) Then
'objMail.Display 'To check emails found
'Déplacer emails dans un dossier :
objMail.Move myFldr.Folders("23 - Recertification").Folders("Temp")
'Next
End If
Next
End Sub
'####### STEP 2
Private Sub Email_SaveAttchementsToDisk_Outlook()
' https://stackoverflow.com/questions/42539438/excel-vba-outlook-search-multiple-criteria-id-and-date
' https://stackoverflow.com/questions/15531093/save-attachments-to-a-folder-and-rename-them
Dim outlookapp As Object
Dim olNs As Outlook.Namespace
Dim myFldr As Outlook.Folder
Dim objMail As Object
Dim myTasks As Outlook.Items
Dim daysAgo As Long
Dim projIDsearch0 As String
Dim myRecipient As Outlook.Recipient
Dim outMailItem As Outlook.MailItem
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
'Initialisation
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("isec-iss-controls@ca-cib.com")
Param_projIDsearch0 = Sheets("PilotageCtrlAuto").Range("K13").Value
Param_projIDsearch1 = Sheets("PilotageCtrlAuto").Range("K14").Value
Param_daysAgo = Sheets("PilotageCtrlAuto").Range("K15").Value
Param_saveFolder = Sheets("PilotageCtrlAuto").Range("K16").Value
'Declare Folder Destination to attach files to hard disk
'saveFolder = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Découpés\__TEST\"
saveFolder = Param_saveFolder
'Check access to Outlook Inbox
myRecipient.Resolve
'Declare Shared Email Inbox
'Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox)
Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox).Folders("23 - Recertification").Folders("Temp")
'Declare subject to look for into email on Outlook
projIDsearch0 = Param_projIDsearch0 '"RE: [TEST]" 'AM
projIDsearch1 = Param_projIDsearch1
Len_projIDsearch0 = Len(projIDsearch0)
Len_projIDsearch1 = Len(projIDsearch1)
' Restrict search to daysAgo' daysAgo = 0 => Emails from today only
daysAgo = Param_daysAgo '1
'Restriction on emails to look for :
Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
For Each objMail In myTasks
If (InStr(1, Left(objMail.Subject, Len_projIDsearch0), projIDsearch0, vbTextCompare) > 0 Or InStr(1, Left(objMail.Subject, Len_projIDsearch1), projIDsearch1, vbTextCompare) > 0) Then
'objMail.Display 'To check emails found
' Save attachments into folder destination
Set outMailItem = outItem
For Each outAttachment In objMail.Attachments
If Right(outAttachment.Filename, 5) = ".xlsx" Then
outAttachment.SaveAsFile saveFolder & outAttachment.Filename
End If
Set outAttachment = Nothing
Next
End If
Next
End Sub
'####### STEP 3
Private Sub Deplacer_Email_Questions_Outlook()
'https://docs.microsoft.com/fr-fr/office/vba/api/Outlook.Items.Restrict
Dim outlookapp As Object
Dim olNs As Outlook.Namespace
Dim myFldr As Outlook.Folder
Dim myFldrDest As Outlook.Folder
Dim objMail As Object
Dim myTasks As Outlook.Items
Dim daysAgo As Long
Dim projIDsearch0 As String
Dim myRecipient As Outlook.Recipient
Dim outMailItem As Outlook.MailItem
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
'Initialisation
Set outlookapp = CreateObject("Outlook.Application")
Set olNs = outlookapp.GetNamespace("MAPI")
Set myRecipient = olNs.CreateRecipient("isec-iss-controls@ca-cib.com")
Param_projIDsearch0 = Sheets("PilotageCtrlAuto").Range("K13").Value
Param_projIDsearch1 = Sheets("PilotageCtrlAuto").Range("K14").Value
Len_projIDsearch0 = Len(projIDsearch0)
Len_projIDsearch1 = Len(projIDsearch1)
Param_daysAgo = Sheets("PilotageCtrlAuto").Range("K15").Value
'Declare Folder Destination to attach files to hard disk
'saveFolder = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Simulation Manager Fichier\Stockage PJ Retour\"
'Check access to Outlook Inbox
myRecipient.Resolve
'Declare Shared Email Inbox
Set myFldr = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox).Folders("23 - Recertification").Folders("Temp")
Set myFldrDest = olNs.GetSharedDefaultFolder(myRecipient, olFolderInbox).Folders("23 - Recertification").Folders("Temp_Question")
'Declare subject to look for into email on Outlook
projIDsearch0 = Param_projIDsearch0 '"RE: [TEST]" 'AM
' Restrict search to daysAgo' daysAgo = 0 => Emails from today only
daysAgo = Param_daysAgo '1
'Restriction on emails to look for :
Set myTasks = myFldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
For Each objMail In myTasks
If (InStr(1, Left(objMail.Subject, Len_projIDsearch0), projIDsearch0, vbTextCompare) > 0 Or InStr(1, Left(objMail.Subject, Len_projIDsearch1), projIDsearch1, vbTextCompare) > 0) Then
'objMail.Display 'To check emails found
'Déplacer emails dans un dossier :
'objMail.Move myFldrDest
' Save attachments into folder destination
Count = 0 ' => Refraiche Value
Set outMailItem = outItem
For Each outAttachment In objMail.Attachments
If Right(outAttachment.Filename, 5) = ".xlsx" Then
' outAttachment.SaveAsFile saveFolder & outAttachment.Filename
Check_file_xlsx = 1
Count = Count + Check_file_xlsx
End If
Set outAttachment = Nothing
Next
' Si il n'y a aucun PJ avec extension ".xlsx" => Alors on déplace l'email dans Le dossier Questions
If Count < 1 Then
objMail.Move myFldrDest
End If
End If
Next
End Sub
Sub SendEmail_Recertification_Campaign()
'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
'Mise à jour de l'affichage
Application.ScreenUpdating = False
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail_FR = Sheets("PilotageCtrlAuto").Range("K6").Value 'Name_TemplateEmail FR
Name_TemplateEmail_EN = Sheets("PilotageCtrlAuto").Range("K7").Value 'Name_TemplateEmail EN
Path_PJ = Sheets("PilotageCtrlAuto").Range("K3").Value 'Path_ Fichiers Découpés
Path_PJ1 = Sheets("PilotageCtrlAuto").Range("K4").Value 'Path_ Fichier PJ1
Path_File_oft = Sheets("PilotageCtrlAuto").Range("K9").Value 'File .oft
'Initialisation data :
Sheets("PilotageCtrlAuto").Range("D1").Value = ""
Sheets("PilotageCtrlAuto").Range("D2").Value = ""
Sheets("PilotageCtrlAuto").Range("D3").Value = ""
Sheets("PilotageCtrlAuto").Range("D6").Value = ""
Sheets("PilotageCtrlAuto").Select
'Set Date ouverture de fichier
Range("C1") = "Last Opened file @ "
Range("D1") = Now
'Check STEPS
Sheets("Mailing").Select
Range("A1").Select
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")
If Cells(Ligne, 14) = "FR" Then
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail_FR)
With objMail
'.Attachments.Add "\Script-Génération-mails.vbs"
'Set body format to HTML
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = Range("A" & Ligne) '.SentOnBehalfOfName = "isec-iss-controls@ca-cib.com"
.To = Range("B" & Ligne)
.CC = Range("C" & Ligne)
.BCC = Range("P" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Path_PJ & Range("E" & Ligne)
source_file1 = Path_PJ1 & Range("F" & Ligne)
.Attachments.Add source_file
.Attachments.Add source_file1
.Send '.Display
'.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 If
If Cells(Ligne, 14) = "EN" Then
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail_EN)
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)
.BCC = Range("P" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Path_PJ & Range("E" & Ligne)
source_file1 = Path_PJ1 & Range("F" & Ligne)
.Attachments.Add source_file
.Attachments.Add source_file1
.Send '.Display
'.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 If
Next Ligne
'Set Date Enregistrement du fichier
Sheets("PilotageCtrlAuto").Activate
Range("C2") = "Last time file saved @ "
Range("D2") = Now
Range("C3") = "Temps de Traitement (Min) : "
Range("D3") = DateDiff("n", Range("D1"), Range("D2"))
'Nbr Emails Sent
Sheets("PilotageCtrlAuto").Range("C6").Value = "Status :"
Sheets("PilotageCtrlAuto").Range("D6").Value = DernLigne - 1 & " emails have been sent @ " & Format(Now, "yyyy-mm-dd hh:mm:ss")
'Mise à jour de l'affichage
Application.ScreenUpdating = True
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Application.Quit ' Quit Excel
End Sub
#######################################################
# Script ReCertification
# Step5_Recertif_Files_Incompleted
# Recertification Déplacer des fichiers incomplets:
#
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Recertification\Step5_Recertif_Files_ToBeRemoved.ps1
#######################################################
Write-Host "Start processing files..."
# Déplace les fichiers .xlsx qui ont un text = "removed" dans la colonne E de l'onglet 2
$Pathfiles = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\Fichiers Retour\"
$Destination = "$Pathfiles" + "_Not Completed\"
$SearchText = '' # 'removed'
$Excel = New-Object -ComObject Excel.Application
$Files = Get-ChildItem $Pathfiles"*.xlsx" | Select -Expand FullName
$counter = 1
$counterFileMoved = 0
ForEach($File in $Files){
Write-Progress -Activity "Checking: $file" -Status "File $counter of $($files.count)" -PercentComplete ($counter*100/$files.count)
$Workbook = $Excel.Workbooks.Open($File)
$WorkSheet = $WorkBook.Sheets.Item("ISS")
$Rows = ($WorkSheet.UsedRange.Rows).count
$Range = "E1:E" + "$Rows"
# Write-Host $Rows
# If($Workbook.Sheets.Item(1).Range("E:E").Find($SearchText)){
If($Workbook.Sheets.Item("ISS").Range($Range).Find($SearchText)){
$counterFileMoved++
# Pas de text trouvé, on ferme le fichier
$Workbook.Close($false)
# Si le texte recherché est trouvé alors on déplace les fichiers dans un nouveau dossier : )
# Moved $file to $destination"
Move-Item -Path $File -Destination $Destination
Write-Host $counterFileMoved "Files has been moved to 'Not_Completed' Folder" -BackgroundColor Yellow
# break
}
else {
$workbook.close($false)
}
$counter++
}
# Synthèse du traitement
If( $counterFileMoved -eq 0 ){ Write-Host "All files are completed !!!" -BackgroundColor Green} else
{
$Resultat = $counter-$counterFileMoved-1
Write-Host "$Resultat" "files are completed !!!" -BackgroundColor Green
}
Write-Host "End process"
#######################################################
# Script GLOBAL PROCESS - ReCertification
# *** GLOBAL_PROCESS_Recertification ***
#
# CMD :
# C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe
# -File P:\Test\Powershell\Script\Recertification\GLOBAL_PROCESS_Recertification.ps1
#######################################################
Write-Host "Starting Merging Files"
# Step 01 : Call Excel File
$excel= new-object -comobject excel.application
$excel.Visible = $false
$excel.DisplayAlerts = $false
$classeur=$excel.workbooks.open("\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\_Lot_Concat\_Fusion_Fichier_Excel.xlsm")
# Test pouir lancer une macro
$excel.Run('Fusion_classeur_Excel')
# get-process *excel* | stop-process -force
Write-Host "End process"