Microsoft 365 Recordset avec fichier TSV

[Florian53]

Bonjour à tous,

Je souhaite créer une requête SQL afin d'alimenter un Array depuis un fichier TSV:

Avec un fichier Excel, l'exercice fonctionne très bien, cependant avec un fichier TSV, j'ai une erreur '3001' ( Les arguments sont de types incorrect, en dehors des limites autorisées ou en conflit les uns avec les autres ).
Ma variable "Lst" contient le chemin ainsi que le nom du fichier.

J'aimerais que cette fonction me renvoie un tableau de type Array du fichier TSV, ça fonctionne très bien avec un fichier Excel mais je ne vois pas ce qui bloque sur un fichier TSV. Avez vous une solution ?

 Function Import_data(Lst)
    'Objectif : 'Importation de fichier avec la méthode ADO
    'Methode : Commande SQL
    'Date : 30/10/19
    'MAJ : 30/10/19
    'Fait par : Guerrier Florian

    Dim Rst As ADODB.Recordset
    Dim intTblCnt As Integer
    
    Set Cn = New ADODB.Connection
        
    With Cn
        '.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Lst & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
        .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Lst & ";Extended Properties=""text;FMT=Delimited(" & vbTab & ");"
            
    End With

    Set Rst = Cn.OpenSchema(adSchemaTables)
    intTblCnt = Rst.RecordCount

    If intTblCnt > 1 Then MsgBox "Le fichier ne peut contenir qu'un onglet Raw": Test_error = True: Exit Function

    strTbl = Rst.Fields("TABLE_NAME").Value
    
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute("SELECT * FROM [" & strTbl & "] ")
    
    Import_data = Rst.GetRows
    
    'Libération de la mémoire
    Cn.Close
    Set Cn = Nothing: Set Rst = Nothing
              
End Function

Merci à vous

 

[Florian53]

J'ai essayé avec 2 autres méthodes, toujours une erreur mais celle ci est différente: " n'est pas un chemin valide. Assurez vous que le nom du chemin d'accès est correct et qu'une connexion est établie avec le serveur sur le quel réside le fichier".

    With Cn
        '.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Lst & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
        '.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Lst & ";Extended Properties=""Text;HDR=YES;IMEX=2;FMT=Delimited""", Path.GetDirectoryName(Lst)
        '.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Lst & ";Extended Properties=""text;FMT=Delimited(" & vbTab & ");"
        .Open "Provider=Microsoft.Jet.Oledb.4.0;" & "Data Source = " & Lst & ";" & "Extended Properties='text; " & "HDR=Yes;" & "FMT=TAB' "
      
    End With

 

[Hasco]

Bonjour,

Vous avez excel 365, utilisez power query qui gère très bien ce genre de choses. vous pourrez importer, sélectionner, manipuler et transformer vos données.

Sur ma version (2019) c'est dans l'onglet de ruban 'Données/ à partir d'un fichier texte/csv'.

A l'étape de sélection du fichier, afficher "Tous les fichier : *.*"
une fois le fichier choisit, dans la fenêtre ci-dessous cliquez sur le bouton 'transformer les données' pour manipuler et ou filtrer les données ou cliquez sur 'Charger' pour charger directement l'ensemble des données dans une feuille excel.

si vous développez le bouton 'Charger' (en cliquant sur la flèche à droite de 'Charger') vous obtiendrez une option 'Charger dans...' qui vous permettra de choisir une cellule précise de destination.

Cordialement

 

[Florian53]

Bonjour Roblochon,

merci pour votre réponse mais je cherches une solution en vba car je dois gérer une dizaine de fichier individuel afin de retraiter entre eux.

 

[Hasco]

Re,

... car je dois gérer une dizaine de fichier individuel afin de retraiter entre eux.

Raison de plus, PowerQuery sait parfaitement faire ce genre de choses. Il peut ouvrier, assembler et traiter des fichiers individuels.

Sinon dans votre chaine de connexion essayez : FMT=TabDelimited au lieu de
FMT=Delimited(" & vbTab & ")


cordialement

 

[Florian53]

Pour l'utilisateur lambda qui utilisera le fichier, je pense que c'est complique de faire ouvrir power query, actuellement j'ai créer une feuille avec des boutons afin de charger les fichiers souhaités, sa me parait plus simple d'utilisation.

 

[Hasco]

Les utilisateurs lambda, n'auront pas à ouvrir powerquery.

Mais puisque vous semblez résistant à la nouveauté, je vous laisse. De plus je ne sais rien de votre projet.

P.S. j'ai rééditez mon précédent message pour vous proposer une correction de votre chaîne de connexion.

Bonne continuation

 

[Florian53]

J'ai la possibilité de charger 3 à 14 fichiers, 3 sont obligatoires et en fonction de certains choix deviennent obligatoire aussi, donc au maximum je peux avoir 14 fichiers tsv à charger.

j'ai créer un tableau 'Rec(1 to 14)

Chaque fichier chargé alimente un Rec(x) en fonction des 'Rec(x)' Empty ou non j'en déduit le type d'analyse à effectuer.

Je ne vois pas comment je peux gérer cette problématique avec PowerQuery.

J'ai essayé, ceci mais le résultat est le même:

.Open "Provider=Microsoft.Jet.Oledb.4.0;" & "Data Source = " & Lst & ";" & "Extended Properties='text; " & "HDR=Yes;" & " [B]FMT=TabDelimiter[/B] ' "

 

[Hasco]

Re,

Euh, excusez moi, il s'agit de 'TabDelimited' avec un 'd' et non un 'r' final.
De plus cela marche mieux si votre répertoire datasource contient un fichier schema.ini décrivant votre fichier, ses colonnes et autres joyeusetés tatillonnes.

En tout cas un fichier texte avec ADODB ne se traite pas de la même manière qu' un fichier excel.

Je viens d'essayer ce bout de code qui fonctionne si je change l'extension du fichier tsv en .csv :

Dim cnx As Object, rst As Object
Set cnx = CreateObject("adodb.connection")
cnx.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & ";Extended Properties=""text;FMT=TabDelimited;HDR=YES"";"
Set rst = CreateObject("adodb.recordset")
rst.Open "SELECT * FROM [table.csv];", cnx
Feuil2.Range("A1").CopyFromRecordset rst
rst.Close
Set rst = Nothing
cnx.Close
Set cnx = Nothing

Avec le csv suivant

titre    truc    chose    blabla
1    2    3    4
5    6    7    8
9    10    11    12

et le schema.ini suivant dans le même répertoire

[table.csv]
ColNameHeader=True
Format=TABDelimited
Col1="titre" Text
Col2="truc" Double
Col3="chose" Double
col4="blabla" text

Les colonnes 1 et 4 sont bien retournées en format texte et les 2 et 3 en numérique.

Bonnes recherches

 

[fanch55]

Bonsoir,
@Roblochon a tout à fait raison,
Si vous voulez importer un fichier par ADO avec des délimiteurs autres que la virgule, il vous faudra passer par un fichier Schema.ini ( comme depuis les débuts d'Excel ... )

Sinon, comme vous semblez importer la totalité du fichier Tsv, vous pouvez tester le code ci-joint :

Sub Import_Tabbed_File()
    Cells.Clear
    File = ' nom complet du fichier avec son dossier
    With ActiveSheet.QueryTables.Add( _
        Connection:="TEXT;" & File, Destination:=Range("$A$1"))
        .SaveData = False
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileTabDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End Sub

 

[Florian53]

Bonjour Roblochon, fanch55

Merci pour ces conseils, je ne connaissais pas du tout cette utilisation de fichier Schema.ini, je n'ai pas vu votre réponse pour le coup j'ai continué à avancer dans mon projet, et j'ai opté pour cette solution:

 Function Import_data(Lst)
    Dim wbk As Workbook

    Application.ScreenUpdating = False
    
    'Changement d'extension
    sourc = Lst: destination = Left(sourc, Len(sourc) - 3) & "txt"

    'Copie du fichier en changeant l'extension
    FileCopy sourc, destination
    
    'Ouverture du fichier
    Workbooks.OpenText Filename:=destination, _
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1))
    
    Set wbk = ActiveWorkbook
    'Mise en mémoire des données
    Import_data = wbk.ActiveSheet.UsedRange
    wbk.Close
    'Destruction du fichier tampon
    Kill destination
    Application.ScreenUpdating = True
    
    
    Set wbk = Nothing
        
End Function

Beaucoup moins esthétique, beaucoup moins rapide mais fonctionnel, ce ne sont pas de gros fichier que j'ai à charger donc le temps de latence est infime, je suis convaincu que si les fichiers auraient été lourd en datas, le temps serait considérable.

Je vais voir pour essayer de faire la manip par ADO quand même, voici en pièce jointe, la façon que j'utilise pour appeler les fichiers. Maintenant la difficulté que je vais avoir, va être la compatibilité sous MAC, j'espère que "FileCopy" ne va pas faire des siennes .

J'utilise ces fonctions pour détecter et charger les fichiers :

Function Select_File_Or_Files_Mac()
        Dim MyPath As String
        Dim MyScript As String
        Dim MyFiles As String
        Dim MySplit As Variant
        Dim N As Long
        Dim Fname As String
        Dim mybook As Workbook

        On Error Resume Next
        MyPath = MacScript("return (path to documents folder) as String")
        'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

        ' In the following statement, change true to false in the line "multiple
        ' selections allowed true" if you do not want to be able to select more
        ' than one file. Additionally, if you want to filter for multiple files, change
        ' {""com.microsoft.Excel.xls""} to
        ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
        ' if you want to filter on xls and csv files, for example.
        MyScript = _
        "set applescript's text item delimiters to "","" " & vbNewLine & _
                   "set theFiles to (choose file of type " & _
                 " {""com.microsoft.Excel.xls""} " & _
                   "with prompt ""KPAM: Selectionner un fichier"" default location alias """ & _
                   MyPath & """ multiple selections allowed false) as string" & vbNewLine & _
                   "set applescript's text item delimiters to """" " & vbNewLine & _
                   "return theFiles"

        MyFiles = MacScript(MyScript)
        On Error GoTo 0

        If MyFiles <> "" Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With

            MySplit = Split(MyFiles, ",")
            For N = LBound(MySplit) To UBound(MySplit)

                ' Get the file name only and test to see if it is open.
                Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
                If bIsBookOpen(Fname) = False Then

                    Set mybook = Nothing

                Else
                    MsgBox "Fermer le fichier : " & MySplit(N) & " avant de lancer l'analyse."
                    Select_File_Or_Files_Mac = Nothing: Exit Function
                End If
                Select_File_Or_Files_Mac = MySplit(N)
                
            Next N
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        End If
    End Function

    Function bIsBookOpen(ByRef szBookName As String) As Boolean
    ' Contributed by Rob Bovey
        On Error Resume Next
        bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
    End Function
    
Function Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Workbooks(ActiveWorkbook.Name).Path

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel 97-2003 Files  (*.tsv), *.tsv,(*.xls), *.xls", _
            Title:="KPAM: Selectionner un fichier", _
            MultiSelect:=True)

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing

            Else
                MsgBox "Fermer le fichier : " & Fname(N) & " avant de lancer l'analyse."
                Select_File_Or_Files_Windows = Nothing
            End If
            
            Select_File_Or_Files_Windows = Fname(N)
            
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    
End Function

Et cette procédure, pour appeler ces différentes fonction et charger les fichiers:

Sub Chargement_Fichier()
    Dim ws_Formulaire As Worksheet
    Dim val_app&, Nom_fichier As String
    Dim Split_fichier
    Dim Lst()
    
    Set ws_tracker = Sheets("Tracker")
    
    'Liste des fichiers disponible à l'analyse
    Lst = Array("A", "B", "C", "D", "E", _
        "F", "G", "H", "I")
    
    ' Test for the operating system.
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' Windows
        FichierAOuvrir = Select_File_Or_Files_Windows
    Else
        ' MAC
        If val(Application.Version) > 14 Then
            FichierAOuvrir = Select_File_Or_Files_Mac
        End If
    End If
    
    val_app = CInt(Right(Application.Caller, Len(Application.Caller) - 9))
    
    'Alimentation des enregistrements
    With ws_tracker
        .Unprotect
        If FichierAOuvrir <> False Then
            Split_fichier = Split(Dir(FichierAOuvrir), ".")
            rec(val_app) = Import_data(FichierAOuvrir)
            .Shapes.Range(Array("Tick" & val_app)).Visible = True
            .Shapes(Application.Caller).TextFrame.Characters.Text = Split_fichier(0)
            .Columns(3).AutoFit
        Else
            .Shapes.Range(Array("Tick" & val_app)).Visible = False
            Select Case val_app
                Case 10, 18, 22
                    .Shapes(Application.Caller).TextFrame.Characters.Text = "Obligatoire"
                Case Else
                    .Shapes(Application.Caller).TextFrame.Characters.Text = "Optionnel"
            End Select
            
            .Columns(3).AutoFit
        End If
        .Protect
    End With
    
    Call Verification(ws_tracker)
    Set ws_Formulaire = Nothing
End Sub

Voilà pour mon projet , je vais devoir trouver un Mac afin d'essayer tout ça.

 

[Hasco]

Bonjour,

Apparemment tout ceci aurait pu être fait par powerquery, même passer une liste de fichiers facultatifs ou obligatoire. Par contre c'est là qu'est l'os : pq ne fonctionne que sous windows.

Quoique je viens de trouver ceci : Utiliser Power Query dans Excel pour Mac

Bonne journée

 

[dysorthographie]

Bonjour,
Je ne connais pas les fichiers à l'extension TSV, mais ce que je remarque c'est que tu gères cela comme un fichier texte.

Notes donc dans ce cas il faut considérer le répertoire qui contient les TSV comme une base de données et chaque TSV comme une table.
Donc data source doit faire référence au répertoire et la table à fichier#TSV

Je suis d'accord pour Powerquerry mais également pour que tu comprennes ton erreur pour ado!

 

[Hasco]

Bonjour,

e ne connais pas les fichiers à l'extension TSV

Ce ne sont rien d'autre que des fichiers .CSV dont l'extension signale que leur séparateur de champs est la Tabulation Tab Separated Value en lieu de Comma Separated Value

cordialement

 

[dysorthographie]

Bonjour,



Ce ne sont rien d'autre que des fichiers .CSV dont l'extension signale que leur séparateur de champs est la Tabulation Tab Separated Value en lieu de Comma Separated Value

cordialement

oui c'est bien la conclusions que j'ai fait au poste #13!

Ma variable "Lst" contient le chemin ainsi que le nom du fichier.

donc je répète Donc data source doit faire référence au répertoire et la table à fichier#TSV

en revanche je ne vois pas les fichiers TSV dans OpenShema!

Sub test()
Dim Cn As Object, TB() As String
Set Cn = CreateObject("ADODB.Connection")
Const Path As String = "C:\Test"
With Cn
    .Open "Provider=Microsoft.Jet.Oledb.4.0;Data Source = " & Path & ";Extended Properties='text;HDR=Yes;FMT=TabDelimited'; "
    TB = TableToutes(Cn)   
    For Each F In TB
        ShemaIni Path, CStr(F), "TabDelimited"
        Sheets("Test").Cells(Sheets("Test").Rows.Count, "A").End(xlUp).Offset(1).CopyFromRecordset .Execute("Select * from [" & F & "]")
    Next
.close
End With
Set Cn = Nothing
End Sub
Function TableToutes(Connexion As Object) As String()
Dim t() As String, i As Integer
With Connexion.OpenSchema(20)
    While Not .EOF
        ReDim Preserve t(i)
        t(i) = !TABLE_NAME
        i = i + 1
        .MoveNext
    Wend
    TableToutes = t
End With
End Function

Public Sub ShemaIni(Rep As String, fichier As String, Delimited As String, Optional Champs As String = "", Optional NewCsv As Boolean = False)
Dim txt As String
txt = "[" & Replace(fichier, "#", ".") & "]" & vbCrLf & "Format=" & Delimited
If Champs <> "" Then txt = txt & vbCrLf & Champs
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Rep & "\schema.ini", 2, True)
NewFichier.Write txt
NewFichier.Close
If NewCsv = True Then
    Set NewFichier = fso.OpenTextFile(Rep & "\" & Replace(fichier, "#", "."), 2, True)
    NewFichier.Write ""
    NewFichier.Close


End If
Set NewFichier = Nothing
Set fso = Nothing
End Sub