Macro VBA choix + import fichier texte à largeur fixe

[THERY]

Bonjour,

J'ai crée une macro pour importer un fichier txt nommé PRD. Ce fichier contient des DATA issues d'un système AS400 et reprend le carnet d'adresse client du système d'exploitation. Les données sont inscrites en ligne qu'il faut découper pour obtenir les différents éléments (code site, adresse, CP, Ville etc...).
Cette macro doit permettre de choisir le fichier à importer et doit le découper à largeur fixe pour l'importer sur une nouvelle feuille du classeur XL.
J'ai crée le code suivant :
Sub choisirfichierTXTàimporter()
ChDir "D:\"
Filt = "Fichier Txt (*.txt),*.txt,"
Title = "Selectionnez un Fichier Txt a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "Aucun fichier choisi"
Exit Sub
End If
' Importer et découper le fichier txt
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;&fichier", Destination:=Range("A1"))
.Name = "fichier"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileFixedColumnWidths = Array(9, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Je pense que le lien entre le choix du fichier sur la 1ère partie de la macro et l'import du fichier txt choisi n'est pas fait. Peut-être même qu'il y a plus simple...
Avez-vous une solution à me proposer ?

En post fichier XL + fichier txt (volontairement réduit à quelques lignes)
Cyrille.

 

[Guest]

Re : Macro VBA choix + import fichier texte à largeur fixe

Bonjour,

Je n'ai pas testé mais ceci ne peut fonctionner:

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;&fichier", Destination:=Range("A1"))

Sortir &fichier de la chaine de caractère:

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Fichier, Destination:=Range("A1"))

A+

 

[THERY]

Re : Macro VBA choix + import fichier texte à largeur fixe

Bjr,

Je ne peux pas lire le post. On dirait qu'il est bloqué en mode image ?
Pouvez-vous poster le code entier ?

Cyrille

 

[Guest]

Re : Macro VBA choix + import fichier texte à largeur fixe

Bonjour,

Voici le code complet.
En bas, aux lignes commentées, adapter éventuellement les types de données, et largeurs de colonnes.

Code vb:
Sub choisirfichierTXTàimporter()
'ChDir "D:\"
Filt = "Fichier Txt (*.txt),*.txt,"
Title = "Selectionnez un Fichier Txt a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "Aucun fichier choisi"
Exit Sub
End If
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Filename, Destination:=Range("A1"))
.Name = "fichier"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1) 'type de données
.TextFileFixedColumnWidths = Array(9, 2) 'largeurs des colonnes
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub




A+

 

[THERY]

Re : Macro VBA choix + import fichier texte à largeur fixe

Excellent, merci beaucoup HASCO ça marche impeccable !