1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
|
Private Sub MAJForecast_Click()
DoCmd.SetWarnings False
'''''''''''''''''''''''''''''''''''''''''''IMPORT FICHIER FORECAST NR''''''''''''''''''''''''''''''''''''''''''
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcelNR As Object, objExcelHI As Object
Dim objWorkbookNR As Object, objWorkbookHI As Object
Dim colWorksheets As Collection
Dim strPathFileNR As String
Dim strPathFileHI As String
' Establish an EXCEL application object
On Error Resume Next
Set objExcelNR = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcelNR = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace S:\Fraude\...\L_HINROExtract.xlsx with the actual path and filename
strPathFileNR = "S:\Fraude\01_INCIDENTS\Suivi des affaires\Extractions Forecast pour synthèse\L_HINROExtract.xlsx"
blnReadOnly = True ' open EXCEL file in read-only mode
' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbookNR = objExcelNR.Workbooks.Open(strPathFileNR, , blnReadOnly)
For lngCount = 1 To objWorkbookNR.Worksheets.Count
colWorksheets.Add objWorkbookNR.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbookNR.Close False
Set objWorkbookNR = Nothing
If blnEXCEL = True Then objExcelNR.Quit
Set objExcelNR = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TMP_NR_" & colWorksheets(lngCount), strPathFileNR, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
'----------------EFFACEMENT DES DONNEES DANS LES TABLES NR
DoCmd.RunSQL "DELETE FROM T_NR_Identification"
DoCmd.RunSQL "DELETE FROM T_NR_IA"
'----------------REPEUPLEMENT DES DONNEES DANS LES TABLES NR
DoCmd.RunSQL "INSERT INTO T_NR_Identification SELECT * FROM TMP_NR_Identification"
'DoCmd.RunSQL "ALTER TABLE T_NR_Identification ALTER COLUMN Résumé MEMO"
'DoCmd.RunSQL "ALTER TABLE T_NR_Identification ALTER COLUMN [Actions Immédiates]MEMO"
DoCmd.RunSQL "INSERT INTO T_NR_IA SELECT * FROM [TMP_NR_Informations additionelles]"
'----------------SUPPRESSION TABLE TEMPORAIRE NR
DoCmd.RunSQL ("DROP TABLE TMP_NR_Identification")
DoCmd.RunSQL ("DROP TABLE [TMP_NR_Informations additionelles]")
MsgBox "Le chargement des incidents NR est terminé", vbInformation + vbOKOnly, "Import NR"
'''''''''''''''''''''''''''''''''''''''''''IMPORT FICHIER FORECAST HI''''''''''''''''''''''''''''''''''''''''''
' Establish an EXCEL application object
On Error Resume Next
Set objExcelHI = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcelHI = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace S:\Fraude\...\L_HINROExtract.xlsx with the actual path and filename
strPathFileHI = "S:\Fraude\01_INCIDENTS\Suivi des affaires\Extractions Forecast pour synthèse\L_HIExtract.xlsx"
blnReadOnly = True ' open EXCEL file in read-only mode
' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbookHI = objExcelHI.Workbooks.Open(strPathFileHI, , blnReadOnly)
For lngCount = 1 To objWorkbookHI.Worksheets.Count
colWorksheets.Add objWorkbookHI.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbookHI.Close False
Set objWorkbookHI = Nothing
If blnEXCEL = True Then objExcelHI.Quit
Set objExcelHI = Nothing
' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TMP_HI_" & colWorksheets(lngCount), strPathFileHI, blnHasFieldNames, _
colWorksheets(lngCount) & "$"
Next lngCount
' Delete the collection
Set colWorksheets = Nothing
'----------------EFFACEMENT DES DONNEES DANS LES TABLES HI
DoCmd.RunSQL "DELETE FROM T_HI_Identification"
DoCmd.RunSQL "DELETE FROM T_HI_Cause"
DoCmd.RunSQL "DELETE FROM T_HI_Effet"
DoCmd.RunSQL "DELETE FROM T_HI_IA"
'----------------REPEUPLEMENT DES DONNEES DANS LES TABLES HI
DoCmd.RunSQL "INSERT INTO T_HI_Identification SELECT * FROM TMP_HI_Identification"
DoCmd.RunSQL "INSERT INTO T_HI_Cause SELECT * FROM TMP_HI_Causes"
DoCmd.RunSQL "INSERT INTO T_HI_Effet SELECT * FROM TMP_HI_Effets"
DoCmd.RunSQL "INSERT INTO T_HI_IA SELECT * FROM [TMP_HI_Informations additionelles]"
'----------------SUPPRESSION TABLE TEMPORAIRE HI
DoCmd.RunSQL ("DROP TABLE TMP_HI_Identification")
DoCmd.RunSQL ("DROP TABLE TMP_HI_Causes")
DoCmd.RunSQL ("DROP TABLE TMP_HI_Effets")
DoCmd.RunSQL ("DROP TABLE [TMP_HI_Informations additionelles]")
DoCmd.RunSQL ("DROP TABLE TMP_HI_Assurance")
MsgBox "Le chargement des incidents HI est terminé", vbInformation + vbOKOnly, "Import HI"
DoCmd.OpenQuery "Requête1"
DoCmd.SetWarnings True
End Sub |
Partager