Attribute VB_Name = "Import_CSV_v111" '--------------------------------------------------------------------------------------- ' Procédure_____: Import_CSV ' Date__________: 24/12/2021 ' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=266 ' Objet_________: Ouvrir un CSV sans interpréter et Retourner le nombre de colonnes ' Référence_____: Fonction générique à l'initialisation ' Appel_________: Import_CSV(LeFichier, Opt LeSep, Opt LaPage, Opt NbCol, Opt PasdInfo) ' Retour________: Nombre de Colonnes trouvées, et 0 si ouverture impossible ' Options_______: LeSep contient le caractère de séparation, Tabulation par défaut ' Options_______: LaPage de code (ex. 65001 pour UTF-8), xlWindows par défaut ' Options_______: NbCol contient le nombre de colonnes attendues, automatique par défaut ' Options_______: Si PasdInfo := true, n'affiche pas les messages d'erreur ' Compatibilité_: (2003-2019)Office (11.0-16.0)Excel (+)32-bit (+)64-bit ' Statut________: (x)Validé ()En attente validation ()En cours développement '--------------------------------------------------------------------------------------- ' 2009.10.26 v1.00 DEV Création initiale, fournit le nombre de colonnes trouvées si différent. ' 2021.12.23 v1.10 DEV Rend optionnel l'affichage des messages d'erreur ' 2021.12.24 v1.11 DEV Accepte un nombre de colonne inconnu à l'avance (mais plus lent) ' Option Explicit Function Import_CSV(LeFichier As String, Optional LeSep As String = "Tab", Optional LaPage As Variant = xlWindows, Optional NbCol As Variant = 0, Optional PasdInfo = False) As Integer 'Définition des Variables Dim x_Tab, x_Space, x_SCol, x_Comma, x_Other As Boolean Dim x_Sep As String Dim x_NBCT As Variant Dim x_FIArr(), i As Variant ' Affectation des Variables x_Tab = False x_Space = False x_SCol = False x_Comma = False x_Other = False x_Sep = "" x_NBCT = 0 x_FIArr = Array() ' Gestion du séparateur unique Select Case UCase(LeSep) Case "TAB" x_Tab = True Case " " x_Space = True Case ";" x_SCol = True Case "," x_Comma = True Case Else x_Other = True x_Sep = LeSep End Select ' Gestion d'un import au nombre de colonnes inconnu If NbCol = 0 Then ' Ouverture du Fichier (si possible) On Error Resume Next Workbooks.OpenText Filename:=LeFichier, Origin:=LaPage, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, _ ConsecutiveDelimiter:=False, Tab:=x_Tab, Semicolon:=x_SCol, Comma:=x_Comma, Space:=x_Space, Other:=x_Other, OtherChar:=x_Sep On Error GoTo 0 ' If ActiveWorkbook.Name <> ThisWorkbook.Name Then ' Ouverture réussie ' Nombre de colonnes dans l'entête NbCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column ' Le Referme pour l'ouvrir plus tard en format Texte ActiveWorkbook.Close Else ' Ouverture impossible, retournera 0 colonnes NbCol = 0 End If End If ' Ouvre pour un nombre de Colonnes Connu If NbCol > 0 Then ' Création d'un Tableau de Format Texte (pas d'interprétations par Excel) ReDim FIArr(NbCol) For i = 0 To NbCol FIArr(i) = Array(i + 1, 2) Next i ' Tente d'Importer le CSV en format Texte On Error Resume Next Workbooks.OpenText Filename:=LeFichier, Origin:=LaPage, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlTextQualifierNone, _ ConsecutiveDelimiter:=False, Tab:=x_Tab, Semicolon:=x_SCol, Comma:=x_Comma, Space:=x_Space, Other:=x_Other, OtherChar:=x_Sep, FieldInfo:=FIArr On Error GoTo 0 ' If ActiveWorkbook.Name <> ThisWorkbook.Name Then ' Ouverture réussie ' Nombre de colonnes dans l'entête x_NBCT = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Else ' Ouverture impossible, retournera 0 colonnes NbCol = 0 End If End If ' Messages d'Erreur If Not PasdInfo Then If NbCol = 0 Then MsgBox "Impossible d'ouvrir ce fichier : " & LeFichier, Buttons:=vbCritical, Title:="Fichier non Trouvé" ElseIf x_NBCT <> NbCol Then MsgBox "Le Fichier : " & LeFichier & " contient " & x_NBCT & " colonne(s), alors qu'il en était attendu " & NbCol, Buttons:=vbCritical, Title:="Nombre de Colonnes Incorrect" End If End If ' Ne Garde Ouvert que si Correct If x_NBCT <> NbCol Then ' Le Referme pour éviter des erreurs ActiveWorkbook.Saved = True ActiveWorkbook.Close End If ' Informe du nombre de colonnes trouvées réellement (et 0 en erreur) ' moins = pas de risque sur le format des données, mais ce n'est pas normal (pertes ?) ' plus = interprétées, et dans le principe anormal également (nouvelles données ?) Import_CSV = x_NBCT End Function