importation fichier texte

Defcom60 · 23 Janvier 2008

Bonjour,

j'ai trouver sur le forum pour importer plusieurs fichiers a la suite dans une feuille avec ce code

Code:

Dim Directory As String, File As String, Temp As String
Dim NumRow As Long, NumCol As Integer
Dim FF As Integer, I As Integer

Directory = "C:\test\"
File = Dir(Directory & "*.txt")
NumRow = ActiveCell.Row
NumCol = ActiveCell.Column
With ActiveSheet
FF = FreeFile
Do While File <> ""
Open Directory & File For Input As #FF
Do While Not EOF(FF)
Line Input #FF, Temp
Table = Split(Temp, vbTab)
For I = 0 To UBound(Table)
.Cells(NumRow, NumCol + I) = Table(I)
Next
NumRow = NumRow + 1
Loop
Close #FF
File = Dir
Loop
End With

je le trouve cette macro lente par rapport a la macro faite avec excel qui est la suivante

Code:

    Workbooks.OpenText Filename:="J:\TOOL\ta1519.txt", Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

cette macros est quasi instantané mais elle import qu'un fichier

comment faire pour quel importe tous les fichiers txt d'un répertoire dans la même feuille comme dans le code N°1

cordialement.

skoobi · 23 Janvier 2008

Re : importation fichier texte

Bonsoir,

si tu avais regardé les dicussions similaire ci-dessous, tu serais tombé la-dessus

vois si ça te conviens

Defcom60 · 23 Janvier 2008

Re : importation fichier texte

bonsoir,

merci pour ta réponse Skoobi mais mon problème n'est pas la macros elle fonctionne bien mais je la trouve très lente comparer a la méthode qu'utilise excel.

Je cherche juste une méthode pour faire pareil avec celle d'excel.

Staple1600 · 23 Janvier 2008

Re : importation fichier texte

Bonsoir Defcom60, Skoobi, le fil, le forum

C'est normal ta première macro ouvre un seul fichier

Si tu éxécutes l'autre macro dans un répertoire contenant plusieurs fichiers

c'est normal que le temps d'éxécution s'en trouve allongé.

skoobi · 23 Janvier 2008

Re : importation fichier texte

Re,

vois si ça convient (tenir compte des commentaires biensûr):

Code:

Sub test()
With Application.FileSearch
    .LookIn = "J:\TOOL"
    .FileType = msoFileTypeAllFiles
    .Filename = "*txt"
    If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            Workbooks.OpenText Filename:=.FoundFiles(i), Origin _
            :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
'ici il faut que tu copies les cellules importées vers un fichier excel vierge (cette macro
'devra y figurer) que tu alimentes au fur et à mesure des ouvertures des fichiers textes car
'en l'état, ce code va tout simplement ouvrir un fichier excel par fichier txt convertie.
        Next
    End If
End With

End Sub

Edit: Re Jean-Marie

Defcom60 · 24 Janvier 2008

Re : importation fichier texte

bonsoir,

Ca ouvre bien tout me fichier TXT mais dans un classeur different a chaque fois
mais ca ne les met pas a la suite du premier qui est ouvert.

j'ai un peu de mal a comprend ton commentaire skoobi.

cordialement.

skoobi · 24 Janvier 2008

Re : importation fichier texte

Re bonjour,

A la place du commentaire il faut que tu mettes un code qui copie les infos de ce fichier TXT ouvert vers un autre classeur "récup" par exemple puis tu ferme le fichier texte avant de passer au suivant.

un exemple pour copier la cellule A2 du fichier "actif" (dans ton cas le fichier TXT), vers le fichier "récup" qui contient la macro:
ActiveWorkbook.Sheets(1).Range("a2").Copy ThisWorkbook.Sheets(1).Range("a2")

Espérant avoir été plus clair.

MJ13 · 24 Janvier 2008

Re : importation fichier texte

Bonjour à tous,

Regardes les fichiers dans ce post (cela pourrait peut-être t'aider) voir page 1 et 2 où il y a des fichiers.

https://www.excel-downloads.com/threads/pb-dimportation-dobjets-dans-une-macro.83569/

Defcom60 · 24 Janvier 2008

Re : importation fichier texte

Merci MJ13 cela correspond presque a une chose pres je veut pas qu'il rapatrie les valeurs dans mon fichier excel ou je l'execute mais dans un autre classeur qui s'apelle par exemple RecupTXT

Code:

Sub ChoixFichierCumulTXT()
'Code issu en partie de  et d'un code de Coriollan et de http://www.info-3000.com/vbvba/boitedialogueintegree.php

ceclasseur = ThisWorkbook.Name
  FichiersChoisis = Application.GetOpenFilename("Textes purs, *.txt", , , , True)
  
  For Ctr = 1 To UBound(FichiersChoisis)
    'MsgBox FichiersChoisis(Ctr)
    ii = ActiveSheet.Range("a65536").End(xlUp).Row
    Workbooks.OpenText Filename:= _
FichiersChoisis(Ctr), Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True

'inclu_nom_fichier début
derligne = ActiveSheet.Range("a65536").End(xlUp).Row
Range("A1:A" & derligne).Select
    Selection.Insert Shift:=xlToRight
    Selection.FormulaR1C1 = FichiersChoisis(Ctr)
'inclu_nom_fichier fin
derligne = ActiveSheet.Range("a65536").End(xlUp).Row

'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
Rows(1 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1)
ActiveWorkbook.Close savechanges:=False

  Next
End Sub

cordialement

MJ13 · 24 Janvier 2008

Re : importation fichier texte

Re bonjour

Testes ce code

Code:

Sub ChoixFichierCumulTXT()
'Code issu en partie de  et d'un code de Coriollan et de [url=http://www.info-3000.com/vbvba/boitedialogueintegree.php]Les boîtes de dialogues intégrées[/url]
Stop
ceclasseur = ThisWorkbook.Name
leclasseur = "RecupTXT.xls"
  FichiersChoisis = Application.GetOpenFilename("Textes purs, *.txt", , , , True)
  
  For Ctr = 1 To UBound(FichiersChoisis)
    'MsgBox FichiersChoisis(Ctr)
    ii = Workbooks("RecupTXT.xls").Sheets(1).Range("a65536").End(xlUp).Row
    Workbooks.OpenText Filename:= _
FichiersChoisis(Ctr), Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True
'inclu_nom_fichier début
derligne = ActiveSheet.Range("a65536").End(xlUp).Row
Range("A1:A" & derligne).Select
    Selection.Insert Shift:=xlToRight
    Selection.FormulaR1C1 = FichiersChoisis(Ctr)
'inclu_nom_fichier fin
derligne = ActiveWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
Rows(1 & ":" & derligne).Copy Workbooks("RecupTXT.xls").Sheets(1).Range("A" & ii + 1)
ActiveWorkbook.Close savechanges:=False
  Next
End Sub

Defcom60 · 24 Janvier 2008

Re : importation fichier texte

re
ca bloque a cette ligne

Code:

    ii = Workbooks("RecupTXT.xls").Sheets(1).Range("a65536").End(xlUp).Row

error 9
l'indice n'appartient pas à la selection

MJ13 · 24 Janvier 2008

Re : importation fichier texte

Bonjour,

Sur quelle version d'excel es-tu (testé sur 2003 mais problème sur XL2007)?

Sinon il faut faire du débogage (avec F8).

Staple1600 · 24 Janvier 2008

Re : importation fichier texte

Bonjour

EDIT: Effectivement ca fonctionne mais en faisant ce que tu ne veux pas
(lol)

La macro crée un fichier xls pour chaque fichier texte importé.

Avec ces modifications, pas de problèmes rencontrés avec XL2000

Code:

Sub ChoixFichierCumul_PAS_OK_MaiS_JY_Retourne()
'Code issu en partie de:
'et d'un code de Coriollan
'et de Les boîtes de dialogues intégrées
Dim Ctr As Long
Dim nclasseur As String
Dim WKB As Workbook
Set WKB = ThisWorkbook
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
FichiersChoisis = _
Application.GetOpenFilename("Textes purs, *.txt", , , , True)
'ouverture des fichiers texte
For Ctr = 1 To UBound(FichiersChoisis)

Workbooks.OpenText _
    FichiersChoisis(Ctr), xlMSDOS, 1, xlDelimited, xlDoubleQuote, False, True
        Application.DisplayAlerts = False
        'création du nom donné au nouveau fichier
            nclasseur = _
            Left(ActiveWorkbook.Name, _
            Len(ActiveWorkbook.Name) - 4) & ".xls"
        'sauvegarde avec ce nouveau nom
            ActiveWorkbook.SaveAs (nclasseur)
        'Fermeture du classeur
            ActiveWorkbook.Close
    Next
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

En espérant que cela fonctionne sur ton pc

Defcom60 · 24 Janvier 2008

Re : importation fichier texte

re

j'utilise excel 2003 pour information.

je cherche de mon coté.

merci

Staple1600 · 24 Janvier 2008

Re : importation fichier texte

Re

Cette fois cela fonctionne

Code:

Sub ChoixFichierCumulOK_III()
'Code issu en partie de:
'et d'un code de Coriollan
'et de Les boîtes de dialogues intégrées
Dim Ctr As Long
Dim nclasseur As String
Dim ii As Long
Dim WKB As Workbook
Dim derligne As Long
Set WKB = ThisWorkbook
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
FichiersChoisis = _
Application.GetOpenFilename("Textes purs, *.txt", , , , True)
'ouverture des fichiers texte
For Ctr = 1 To UBound(FichiersChoisis)
ii = WKB.Sheets(1).Range("a65536").End(xlUp).Row
Workbooks.OpenText _
FichiersChoisis(Ctr), xlMSDOS, 1, xlDelimited, xlDoubleQuote, False, True
derligne = ActiveSheet.Range("a65536").End(xlUp).Row
Range("A1:A" & derligne).Select
    Selection.Insert Shift:=xlToRight
    Selection.FormulaR1C1 = FichiersChoisis(Ctr)
'inclu_nom_fichier fin
derligne = ActiveWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
Rows(1 & ":" & derligne).Copy WKB.Sheets(1).Range("A" & ii + 1)
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Next
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

Effectuez une recherche sur Excel Downloads...

importation fichier texte

Defcom60

XLDnaute Junior

skoobi

XLDnaute Barbatruc

Defcom60

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

skoobi

XLDnaute Barbatruc

Defcom60

XLDnaute Junior

skoobi

XLDnaute Barbatruc

MJ13

XLDnaute Barbatruc

Defcom60

XLDnaute Junior

MJ13

XLDnaute Barbatruc

Defcom60

XLDnaute Junior

MJ13

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Defcom60

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums