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
| Sub DB_TREAT(ByVal Path_BD As String, ByVal TABLE_BRUTE As String, _
ParamArray ChpCritere() As Variant)
Dim DB As DAO.Database
Dim Rst As DAO.Recordset
Dim RstTMP As DAO.Recordset
Dim intColIndex As Long
Dim strSql As String
Dim strSqlTMP As String
Dim strWhere As String
Dim strSelect As String
'Dim strUpdate As String
Dim v As Long
Set DB = DAO.OpenDatabase(Path_BD, False, False)
For v = LBound(ChpCritere) To UBound(ChpCritere)
strSelect = strSelect & ChpCritere(v) & ", "
Next v
strSelect = Mid(strSelect, 1, Len(strSelect) - Len(", "))
strSql = "SELECT DISTINCT " & strSelect & " FROM " & TABLE_BRUTE
Set Rst = DB.OpenRecordset(strSql, DAO.dbOpenSnapshot)
With Rst
While Not .EOF
strWhere = ""
For i = 0 To .Fields.Count - 1
strWhere = strWhere & .Fields(i).Name & "=" & "'" & Rst(i).Value & "'" & " AND "
Next
strSqlTMP = "SELECT * FROM " & TABLE_BRUTE & " WHERE " & Mid(strWhere, 1, Len(strWhere) - Len(" AND "))
Set RstTMP = DB.OpenRecordset(strSqlTMP, DAO.dbOpenSnapshot)
'
' nom de champs
For intColIndex = 0 To RstTMP.Fields.Count - 1
Worksheets("wSheet").Range("A2").Offset(-1, intColIndex).Value = RstTMP.Fields(intColIndex).Name
Next intColIndex
Worksheets("wSheet").Range("A2").CopyFromRecordset RstTMP
RstTMP.Close
Set RstTMP = Nothing
'---- Traitement Xls -----
' Quelques traitments
'----------------------------
End If
'--- Supprimer les enregist de la table -----
DB.Execute "DELETE * FROM " & TABLE_BRUTE & " WHERE " & Mid(strWhere, 1, Len(strWhere) - Len(" AND "))
'---------------------------------------
.MoveNext
Wend
'--- Nettoyage et libération mémoire
.Close
End With
Set Rst = Nothing
'---------------------
DB.Close
Set DB = Nothing
End Sub |
Partager