Récupérer le type d'une colonne access
-
Bonjour,
Je suis entrain de faire une macro qui met à jour une base de données avec des informations entrées dans un fichier excel.
Pour cela j'utilise le code :
Fonction :
Option Explicit
Public Cnx As Object, Rst As Object
'http://tatiak.canalblog.com/
'https://forum.excel-pratique.com/viewtopic.php?p=761466#p761466
Sub Connect_Access(Accdb As String)
Set Cnx = CreateObject("ADODB.Connection")
Cnx.Provider = "MSDASQL"
Cnx.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Accdb & ";"
Set Rst = CreateObject("ADODB.Recordset")
End Sub
Function Select_Db(Req As String, Optional Head As Byte = 1) As Variant
Dim T As Variant, Rcd As Variant
Dim lig As Long, col As Long, i As Long, j As Long
On Error GoTo errhdlr
ReDim Rcd(1 To 1, 1 To 1)
Rst.Open Req, Cnx, 3
lig = Rst.RecordCount
If lig > 0 Then
Rst.MoveFirst
T = Rst.GetRows
col = Rst.Fields.Count
ReDim Rcd(1 To lig + Head, 1 To col)
For j = 0 To col - 1
Rcd(1, j + 1) = Rst.Fields(j).Name
For i = 0 To lig - 1
Rcd(i + 1 + Head, j + 1) = IIf(IsNull(T(j, i)), 0, T(j, i))
Next i
Next j
End If
Select_Db = Rcd
Exit Function
errhdlr:
Rcd(1, 1) = "Erreur n°" & Err.Number & vbCrLf & Err.Description
Select_Db = Rcd
End Function
Sub Close_Cnx(Optional X As Byte)
On Error Resume Next
If X > 0 Then Rst.Close
Cnx.Close
Set Cnx = Nothing
Set Rst = Nothing
End Sub
Function ExisteFichier(S As String) As Boolean
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
ExisteFichier = tatiak.FileExists(S)
End FunctionCode de MAJ :
Sub update_database()
Dim der_ligne As Integer, der_colonne As Integer
Dim Req As String, str As String
Dim T As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Initialisation"
'Initialisation de certaines variables
feuil = "cde en cours"
der_ligne = ThisWorkbook.Sheets(feuil).Cells(Rows.Count, 2).End(xlUp).Row
annee = Left(Right(ThisWorkbook.Name, 9), 4)
der_colonne = ThisWorkbook.Sheets(feuil).Cells(13, Columns.Count).End(xlToLeft).Column
der_ligne2 = der_ligne + (der_ligne - 13)
Application.StatusBar = "Copie des données initiales"
'On copie les lignes originales de la base de donnée
Req = "SELECT * FROM [cde en cours] WHERE "
For i = 14 To der_ligne
Req = Req & "`numero de cde` = " & ThisWorkbook.Sheets(feuil).Cells(i, 4).Value
If i <> der_ligne Then Req = Req & " OR " Else Req = Req & " ORDER BY [numero de cde]"
Next
Connect_Access ThisWorkbook.Path & "\Suivi cde " & annee & ".accdb" 'Fonction
T = Select_Db(Req, 0) ' avec 1 si on veut l'entête et 0 sinon Fonction
ThisWorkbook.Sheets(feuil).Range("B" & der_ligne + 1).Resize(UBound(T, 1), UBound(T, 2)) = T
Close_Cnx 'Fonction
If Left(Cells(der_ligne + 1, 2).Value, 6) = "Erreur" Then
MsgBox "Une erreur est survenue lors de l'exécution de la mise à jours." & vbLf & "Veuillez supprimer une grande partie des lignes non modifiées puis réessayer.", vbCritical + vbOKOnly
Cells(der_ligne + 1, 2).Delete
Exit Sub
End If
Application.StatusBar = "Préparation des données"
'On insert 3 colonnes
ThisWorkbook.Sheets(feuil).Columns("B:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'on ajoute le champ dans la formule et un ";"
For i = 5 To (der_colonne - 4 + 3)
concatenation = concatenation & Split(Range(ThisWorkbook.Sheets(feuil).Cells(14, i), ThisWorkbook.Sheets(feuil).Cells(14, i)).Address, "$")(1) & "13;"";"";"
Next
'insérer la formule dans la cellule B13
ThisWorkbook.Sheets(feuil).Range("B13").FormulaLocal = "=CONCATENER(" & concatenation & ")"
'étendre la formule à toutes les lignes
ThisWorkbook.Sheets(feuil).Range("B13").AutoFill Destination:=ThisWorkbook.Sheets(feuil).Range("B13:B" & der_ligne2), Type:=xlFillDefault
'créé la liste pour simplifier la formule suivante
ThisWorkbook.Names.Add Name:="Concatenation", RefersTo:=ThisWorkbook.Sheets(feuil).Range("B13:B" & der_ligne2)
'insérer la formule pour trouver les valeurs uniques dans la cellule C13
ThisWorkbook.Sheets(feuil).Range("C14").FormulaLocal = "=SIERREUR(INDEX(Concatenation; EQUIV(0;INDEX(NB.SI(C$13:$C13; Concatenation)+(NB.SI(Concatenation;Concatenation)<>1);0;0); 0));"""")"
'étendre la formule à toutes les lignes
ThisWorkbook.Sheets(feuil).Range("C14").AutoFill Destination:=ThisWorkbook.Sheets(feuil).Range("C14:C" & der_ligne2), Type:=xlFillDefault
'On copie les VALEURS de la colonnes C afin d'enlever les cellules retournants une valeur vide
ThisWorkbook.Sheets(feuil).Range("C14:C" & der_ligne2).Copy
ThisWorkbook.Sheets(feuil).Range("D14").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'On trouve la dernière ligne remplis de la colonne copiée
Der_ligne_result = ThisWorkbook.Sheets(feuil).Cells(Rows.Count, 4).End(xlUp).Row
For i = Der_ligne_result To 1 Step -1
If Cells(i, 4).Value <> "" Then
Der_ligne_result = i
Exit For
End If
Next i
'On détermine la dernière ligne utile
If Der_ligne_result Mod 2 = 0 Then der_ligne_final = 13 + ((Der_ligne_result - 14) / 2) Else der_ligne_final = 13 + ((Der_ligne_result - 13) / 2) + 1
'On supprime les ligne de valeur unique de références
ThisWorkbook.Sheets(feuil).Range("D" & der_ligne_final & ":D" & Der_ligne_result).Value = ""
'On cherche la nouvelle dernière colonne
der_colonne2 = ThisWorkbook.Sheets(feuil).Cells(13, Columns.Count).End(xlToLeft).Column
Application.StatusBar = "Mise à jours des données dans la base"
'On update la table avec les nouvelles valeurs
For i = 14 To der_ligne_final
If ThisWorkbook.Sheets(feuil).Cells(i - passe, 4).Value = "" Then
Exit For
End If
If InStr("1", ThisWorkbook.Sheets(feuil).Cells(i, 7).Value, (Split(ThisWorkbook.Sheets(feuil).Cells(i - passe, 4).Value, ";")(2)), 1) Then
Req = "UPDATE [cde en cours] SET " & vbCrLf
For j = 5 To (der_colonne2 - 4)
If ThisWorkbook.Sheets(feuil).Cells(13, j).Value <> "numero de cde" Then
'conversion en chaine de caractère
str = ThisWorkbook.Sheets(feuil).Cells(i, j).Value
'ajout de la valeur à modifier
Req = Req & "`" & ThisWorkbook.Sheets(feuil).Cells(13, j).Value & "` = '" & str & "'"
'détection de fin de requête, si non ajouter un comparateur
If j < (der_colonne2 - 4) Then Req = Req & ", "
End If '<> "numero de cde"
Next 'j
'ajout de la condition d'update
Req = Req & " WHERE `numero de cde` = " & Split(ThisWorkbook.Sheets(feuil).Cells(i - passe, 4).Value, ";")(2)
'MsgBox Req
Connect_Access ThisWorkbook.Path & "\Suivi cde " & annee & ".accdb" 'Fonction
Cnx.Execute Req
Close_Cnx 'Fonction
Else
passe = passe + 1
End If 'instr
Next 'i
Application.StatusBar = "Nettoyage de la feuille"
'Nettoyage de la feuille
ThisWorkbook.Sheets(feuil).Columns("B:D").Delete Shift:=xlToLeft
ThisWorkbook.Sheets(feuil).Rows(der_ligne + 1 & ":" & der_ligne2).Delete
ThisWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.StatusBar = "Les données ont bien été mises à jours."
Application.Calculation = xlCalculationAutomatic
End SubDans ce code je détecte les lignes qui ont été changées, en comparant à la base de données ( sa risque de changer quand j'aurai trouvé comment détecter les cellules qui ont été changées, et non la ligne entière), puis je génère une requête de mise à jour de la BDD pour les lignes ayant été modifiées.
Le problème est que je ne détecte actuellement pas les type des colonnes et donc la mise à jours ne se fait pas car certaine données sont du mauvais type (je les envoie tous, actuellement, en chaîne de caractère 'xxxxx' donc les date et les nombre ne passe pas).
Si vous avez des code permettant d'obtenir le type de chaque colonne d'une BDD je suis preneur
Cordialement,
Arthur.
Bonjour Arthur,
J'utilise quelques macros pour typer mes données :
' ©------------------
' 017 Format Date SQL
' -------------------
Public Function SQL_Date(D As Range) As String
Dim Da As String
Application.Volatile
Da = "'" & Format(D.Cells.Value, "yyyymmdd") & "'" '"#"
SQL_Date = Da
End Function' ©------------------
' 017 Format Date SQL
' -------------------
Public Function SQL_ExcelDate(D As Range) As String
Dim Da As String
Application.Volatile
Da = D.Cells.Value
MsgBox (Format(Right(Da, 2), "dd") & Format(Mid(Da, 2, 2), "mm") & Format(Left(Da, 4), "yyyy"))
SQL_ExcelDate = Format(Right(Da, 2), "dd") & Format(Mid(Da, 2, 2), "mm") & Format(Left(Da, 4), "yyyy")
End Function' ©-------------------
' 017 Format Texte SQL
' --------------------
Public Function SQL_Texte(D As Range) As String
Dim Da As String
Application.Volatile
Da = "'" & D.Cells.Value & "'"
SQL_Texte = Da
End FunctionPublic Sub SQL_GetSchema()
Dim Requete As String
Dim t As String
Dim i As Integer
i = 1
Set rs = cnn.OpenSchema(adSchemaTables)
While Not rs.EOF
'Selection.Offset(i + 2, 0) = rs!TABLE_NAME
rs.MoveNext
i = i + 1
Wend
End Sub' ©---------------------------------------
' Recupere le type d'une colonne de la BDD à adapter selon besoin
' ----------------------------------------
Function TypeColonne(tName As String, cName As String) As String
TypeColonne = UneRequete("SELECT DATA_TYPE FROM INFORMATION_SCHEMA.COLUMNS WHERE Table_Name='" & tName & "' AND column_name='" & cName & "'")
End FunctionFunction SQL_getPrimaryKeyName(tableName As String)
Dim S As String
Set rs = cnn.OpenSchema(adSchemaPrimaryKeys, Array(Empty, Empty, tableName, Empty))
S = rs("COLUMN_NAME")
SQL_getPrimaryKeyName = S
End FunctionJ'espère que ces codes te seront utiles, ils fonctionnent pour SQLServer, pour Access, je ne sais pas.
Comme tu le lis, pour récupérer les types de données, tout se passe en SQL en interrogeant les schémas des tables systèmes.
-
Merci oxydum pour ces fonctions,
Je viens d'essayer
SELECT DATA_TYPE
FROM [cde en cours].COLUMNSafin d'obtenir les DATA_TYPE de toutes mes colonnes de ma table "cde en cours". Malheureusement j'obtiens une erreur :
Fichier "C:\....\cde en cours.mdb" introuvable.
Aurais-tu une idée ?
-
J'ai aussi essayé :
SELECT DATA_TYPE
FROM INFORMATION_SCHEMA.COLUMNS
WHERE Table_Name='cde en cours'mais cette fois ci il ne trouve pas la table INFORMATION_SHEMA.COLUMNS
:/
-
Finalement en bidoullant dans les paramètres d'access, j'ai pu afficher les table cachées et trouver la table qui regroupes les types des colonnes : MSyslMEXColumns
Je vais adapter le code que tu m'as filé et voir si sa passe
-
SELECT FieldName,DataType
FROM MSysIMEXColumns
ORDER BY StartNous affichera le nom des champs et leur type de données de la colonne (en code), le tout dans l'ordre du tableau.
Pour ceux intéresser
Merci pour ton retour