Insertion .txt dasn Excel

Le 11/05/2016 à 14:24

Bonjour

Voici mon problème, je souhaite importer des fichiers .txt dans excel, un fichier par page excel.

Voici la VBA que j'utilise :

Sub insertion_txt_auto()

Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object

Dim str() As String
Dim strLigne As String

Dim i As Long
Dim c As Integer

Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder("H:\These\manip\TEOS_EtOH_TEP_ABTES\vba")

For h = 1 To 22

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "TEOS_EtOH_TEP_ABTES_" & h

Next h

h = 1

'Boucle sur fichiers du repertoire

iCopie = 2
For Each FsoFichier In FsoRepertoire.Files

    str = Split(FsoFichier.Name, ".")

    If str(UBound(str)) = "txt" Then

        Open FsoFichier For Input As #1
        i = 1
        Do While Not EOF(1)

            Line Input #1, strLigne

            Sheets("TEOS_EtOH_TEP_ABTES_" & h).Select
            Cells(i, 1).Value = strLigne
            i = i + 1

        Loop
h = h + 1
        Close #1

    End If

Next

End Sub

Le problème avec cette VBA, c'est que tout mon ficher .txt est inséré dans une seule colonne, or je souhaiterai avoir une colonne du txt = à une colonne excel.

Si je fais la réalisation de macro automatique pour importer correctement le fichier txt j'obtiens ceci :

Sub insertion_txt_manuelle()
'
' Macro2 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;H:\These\manip\TEOS_EtOH_TEP_ABTES\test.txt", Destination:=Range("$A$1" _
        ))
        .Name = "test"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Mais j'arrive pas à croiser les deux VBA.

Je vous joins un PJ un exemple de fichier txt

En vous remerciant.

14fichier2.zip (56.23 Ko)
15fichier1.zip (34.64 Ko)
Le 11/05/2016 à 15:08

Bonjour,

Je te donne un exemple d'importation de ton fichier vers la feuille2 de ton fichier macro.

Sub Import()
myName = "TEOS_EtOH_TEP_ABTES_2.txt"
            Workbooks.OpenText Filename:=myName, Origin:=xlWindows, _
                StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
            With ActiveWorkbook
                .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets(2).Range("A1")
                .Saved = True
                .Close
            End With
End Sub

ça me semble plus simple que ce tu utilises. Tu pourras peut-être adapter ça à ce que tu veux faire.

Sinon j'essaierai ce soir à la veillée...

A+

Le 11/05/2016 à 15:27

Ok,merci

mais en fait quand j'ai ce type de code j'arrive pas à faire une boucle pour qu'il m'ouvre tout mes fichiers .txt page par page.

Par contre ca règle super bien le problème des colonnes et des données séparées.

Le 11/05/2016 à 16:29

bonsoir,

Voilà qui devrait convenir :

Sub insertion_txt_auto()
Dim Fso, FsoRep, FsoFile
Dim i%, Arr$()

Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRep = Fso.GetFolder("H:\These\manip\TEOS_EtOH_TEP_ABTES\vba")
   For i = 1 To 22
      Sheets.Add After:=Sheets(Sheets.Count)
      ActiveSheet.Name = "TEOS_EtOH_TEP_ABTES_" & h
   Next i
   'Boucle sur fichiers du repertoire
   For Each FsoFile In FsoRep.Files
      Arr = Split(FsoFile.Name, ".")
      If Arr(UBound(Arr)) = "txt" Then
         Import (Arr(0))
      End If
   Next
End Sub

Sub Import(SFile$)
   Workbooks.OpenText Filename:=SFile, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
   With ActiveWorkbook
       .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.Sheets(2).Range("A1")
       .Saved = True
       .Close
   End With
End Sub

A+

Le 11/05/2016 à 16:46

=(

Ca ne fonctionne pas

J'obtiens "la méthode "opentext" de l'objet "workbooks a échoué. Lors de la seconde VBA

Le 11/05/2016 à 16:51

Oups !

remplacer les 2 macros par celle-ci (testée sur mon chemin...)

Sub insertion_txt_auto()
Dim Fso, FsoRep, FsoFile
Dim i%, Arr$()

Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRep = Fso.GetFolder("H:\These\manip\TEOS_EtOH_TEP_ABTES\vba")
   For i = 1 To 22
      Sheets.Add After:=Sheets(Sheets.Count)
      ActiveSheet.Name = "TEOS_EtOH_TEP_ABTES_" & i
   Next
   For Each FsoFile In FsoRep.Files
      Arr = Split(FsoFile.Name, ".")
      If Arr(UBound(Arr)) = "txt" Then
      Workbooks.OpenText Filename:=FsoFile.Name, Origin:=xlWindows, _
          StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
         With ActiveWorkbook
             .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.ActiveSheet.Range("A1")
             .Saved = True
             .Close
         End With

      End If
   Next
End Sub

A+

Le 11/05/2016 à 17:09

J'ai fait ça :

 Sub a()

Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object

Dim str() As String
Dim strLigne As String

Dim i As Long
Dim c As Integer

Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder("C:\Users\rbertrand\Desktop\Testvba")

For h = 1 To 1

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "fichier" & h

Next h

h = 1

'Boucle sur fichiers du repertoire

iCopie = 2
For Each FsoFichier In FsoRepertoire.Files

    str = Split(FsoFichier.Name, ".")

    If str(UBound(str)) = "txt" Then

        Open FsoFichier For Input As #1
        i = 1
        b = 1
        Do While Not EOF(1)

            Line Input #1, strLigne

            Mavariable = Split(strLigne, Chr(9))

For comp = 0 To 16

            Sheets("fichier" & h).Select

            Cells(i, b).Value = Mavariable(comp)
           b = b + 1
 Next comp

  i = i + 1
  b = 1
        Loop

h = h + 1
        Close #1

    End If

Next

End Sub

Mais je ne sais pas pourquoi y a un problème au niveau des séparateur, la 1ere colonne marche nikel mais dès la seconde, les , disparaissent.

Le 11/05/2016 à 19:16

Bon,

J'ai tout remis à plat remplace TOUSSA par cette macro testée cette fois ci (sur mon chemin)

Sub insertion_txt_auto()
Dim Fso, FsoRep, FsoFile
Dim i%, Arr$()

Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRep = Fso.GetFolder("H:\These\manip\TEOS_EtOH_TEP_ABTES\vba")
   For i = 1 To 22
      Sheets.Add After:=Sheets(Sheets.Count)
      ActiveSheet.Name = "TEOS_EtOH_TEP_ABTES_" & i
   Next
   For Each FsoFile In FsoRep.Files
      Arr = Split(FsoFile.Name, ".")
      If Arr(UBound(Arr)) = "txt" Then
      Workbooks.OpenText Filename:=FsoFile.Name, Origin:=xlWindows, _
          StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
         With ActiveWorkbook
             .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.ActiveSheet.Range("A1")
             .Saved = True
             .Close
         End With
      End If
   Next
End Sub

A+

Le 12/05/2016 à 09:04

Je suis navré mais ca marche toujours pas, ci-joint en pj la photo du message d'erreur

j'ai vérifié tout mes chemins d'accès et nom de fichier tout correspond.

J'ai modifié un ou deux truc, le fichier est bien trouvé, mais c'est au niveau de la ligne de commande "workbook...." que ca plante.

Est ce qu'il ne peut pas y avoir un pb de version Excel je vois que vous avez Excel 2010 et moi 2007

1 2
Le 12/05/2016 à 13:40

Désolé pour moi le problème est réglé, j'ai revérifié et ça passe sans broncher. Je ne sais pas quelle vie tu mène avec tes chemins de fichiers.... Tu es passé de H à C... Fais attention. Il n'y a pas de raison que ça coince.

A+

Le 12/05/2016 à 13:52

Je vais retenter.

Je gère le truc via deux ordinateurs, selon sur lequel je suis c'est h ou c

Le 12/05/2016 à 14:02

Si ça marche sur l'un il n'y a pas de raison que ça ne marche pas sur l'autre...

Le 12/05/2016 à 14:08

Ça marche sur aucun des deux.

Quand je fais la macro ligne par ligne avec F8, il détecte bien le fichier, mais ça bug lorsque ça arrive au workbook.....

Le 12/05/2016 à 14:35

Pourtant ce type de code à bien marché au moins une fois car quand je t'ai donné la macro Import. Tu m'a répondu :

Par contre ca règle super bien le problème des colonnes et des données séparées.

??

Je n'ai pas d'autre idée.

A+

Le 12/05/2016 à 14:38

C'est bon

    Sub insertion_txt_auto()
    Dim Fso, FsoRep, FsoFile
    Dim i%, Arr$()
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRep = Fso.GetFolder("C:\Users\rbertrand\Desktop\Testvba")
       For i = 1 To 2
          Sheets.Add After:=Sheets(Sheets.Count)
          ActiveSheet.Name = "ggg" & i
       Next
       For Each FsoFile In FsoRep.Files

          Workbooks.OpenText Filename:=FsoFile, Origin:=xlWindows, _
              StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
             With ActiveWorkbook
                 .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.ActiveSheet.Range("A1")
                 .Saved = True
                 .Close
             End With

       Next
    End Sub

j'ai enlever le .name dans le filename

Encore Merci

Le 12/05/2016 à 17:58

Parfait !

C'est l'inconvénient quand on joue avec le système de fichier, on ne peut pas se projeter exactement dans vos conditions de travail.

Malgré de nombreux tests, préoccupé par les problèmes de concordance de fichier, de répertoire et les nombreuses modifs, je n'ai pas vu le loup !

A+

Le 13/05/2016 à 08:29

En fait voila la version la mieux qui tourne vraiment sans problème, il y avait encore des bugs sur l'autre

  Sub insertion_txt_auto()
    Dim Fso, FsoRep, FsoFile
    Dim i%, Arr$()
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRep = Fso.GetFolder("C:\Users\rbertrand\Desktop\Testvba")

       For Each FsoFile In FsoRep.Files

           Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Select
            ActiveSheet.Name = FsoFile.Name

          Workbooks.OpenText Filename:=FsoFile, Origin:=xlWindows, _
              StartRow:=1, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=","
             With ActiveWorkbook
                 .Sheets(1).Range("A1").CurrentRegion.Copy ThisWorkbook.ActiveSheet.Range("A1")
                 .Saved = True
                 .Close
             End With

       Next

    End Sub
Le 13/05/2016 à 09:27
            ActiveSheet.Select
            ActiveSheet.Name = FsoFile.Name

Beurk !

Le 13/05/2016 à 10:23

^^

Pourquoi?

ca se répète?

je n'ai pas besoin du "activeSheet.select"?

Le 13/05/2016 à 10:32

Ben oui... Puisqu'elle est déjà active : Elle ne peut que le rester !

A+

Rechercher des sujets similaires à "insertion txt dasn"