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
|
'***************************************************
Private Sub Import_T_ref_Domaine()
'***************************************************
' source onglet: InputWkb1.Worksheets(4) , la récupération des données commence ici à la ligne : row 1 (ligne des entetes )
' Import dans table T_ref_Domaine
'---------------------------------------------------
Dim InputSht1 As Worksheet
Dim Arr1() As Variant
Dim i As Long, j As Long
Dim LastRow As Long, LastCol As Long, strSql As String
Dim myDb As DAO.Database
Dim rs1 As DAO.Recordset
Dim StatusMsg As String, varReturn As Variant, lCount As Long, strTable As String
Dim strRegroupDefaultValue As String
Dim TimerDeBut As Double
TimerDeBut = Timer
strTable = "T_ref_Domaine"
StatusMsg = "Patientez, importation dans " & strTable & " en cours d'exécution..."
'Call GetDbFullpath(strTable) ' retourne la valeur de myDbData
Set myDb = CurrentDb
strSql = "DELETE * FROM " & strTable
myDb.Execute strSql, dbSeeChanges
'strSql = "ALTER TABLE " & strTable & " ALTER COLUMN Ref_id COUNTER (1,1)"
' myDb.Execute strSql, dbSeeChanges
Set rs1 = myDb.OpenRecordset("SELECT * FROM " & strTable, dbOpenDynaset, dbSeeChanges)
Set InputSht1 = InputWkb1.Worksheets(4)
With InputSht1
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
LastCol = .UsedRange.Columns(.UsedRange.Columns.Count).Column
Arr1 = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
i = 1
For j = 1 To LastCol
Debug.Print "entête_colonne " & j & " : " & UCase(Arr1(1, j))
Next j
' Colonnes de la feuille "Colonnes Import"
' ----------------------------------------
' Info nb ligXL : 140
' Info nb colXL : 4
' entête_colonne 1: DOMAINE
' entête_colonne 2: LIBELLÉ DOMAINE
' entête_colonne 3: FILIÈRE
' entête_colonne 4: Code APAC
' Table T_ref_Domaine
' -------------------
' SELECT Dom_cle, Metier, Dom_libelle, Dom_Filiere, APAC_SCode, CreatDate, CreatUser
Debug.Print "i max : " & UBound(Arr1, 1)
Debug.Print "j max : " & UBound(Arr1, 2)
varReturn = SysCmd(acSysCmdInitMeter, StatusMsg, UBound(Arr1, 1))
For i = 2 To UBound(Arr1, 1)
DoEvents
varReturn = SysCmd(acSysCmdUpdateMeter, i) 'Progression
If IsNothing(Arr1(i, 1)) Then
' 2012-05-25
'debug.print "la ligne " & i & " est vide, donc non importée"
Else
rs1.AddNew
For j = 1 To UBound(Arr1, 2)
'Debug.Print "[" & Nz(arr1(i, j), 0) & "]"
Select Case j
Case 1: rs1.Fields("Dom_cle") = Nz(Arr1(i, j), 0)
Case 2: rs1.Fields("Dom_libelle") = Left(Trim(Nz(Arr1(i, j))), rs1.Fields("Dom_libelle").Size)
Case 3: rs1.Fields("Dom_Filiere") = Left(Trim(Nz(Arr1(i, j))), rs1.Fields("Dom_Filiere").Size)
Case 5: rs1.Fields("APAC_SCode") = Left(Trim(Nz(Arr1(i, j))), rs1.Fields("APAC_SCode").Size)
End Select
Next j
rs1.Fields("CreatDate") = Now
rs1.Fields("CreatUser") = Environ("USERNAME")
rs1.Update
End If
Next i
debug.print DCount("*", strTable) & " records importés dans " & strTable
Exit_0:
varReturn = SysCmd(acSysCmdRemoveMeter)
varReturn = SysCmd(acSysCmdClearStatus)
Set rs1 = Nothing
Set myDb = Nothing
Set InputSht1 = Nothing
End Sub |
Partager