Forum > VB.NET et VB 2005 > Base de données > XML
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionAttribute VBA_ModuleType=VBAModule Module1 Sub importation_txt() ' ' importation_txt Macro ' importer et découper le fichier texte ChDrive "D:" ChDir "D:\Perso\ROM1\test macro" Fichier = Application.GetOpenFilename("Texte fichiers (*.txt), *.txt") With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & Fichier, Destination:=Range("$A$1")) .Name = Split(Fichier, "/")(UBound(Split(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 = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = True .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileOtherDelimiter = "." .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub
Les exemples d'ouverture, lecture et écriture de fichiers textes foisonnent littéralement sur ce forum, dont je te rappelle qu'il dispose d'un moteur de recherche.
un collègue m'ayant parler de ce site, m'a dit que je trouverai le bon samaritain pour m'aider
Option Explicit Private Sub CommandButton1_Click() Dim derlig As Integer, ligne As String, feuille_desti As String Application.ScreenUpdating = False feuille_desti = "Feuil2" derlig = Range("A:A").End(xlDown) ChDrive "F:" ChDir "F:\Perso\ROM1\test macro" Fichier = Application.GetOpenFilename("Texte fichiers (*.txt), *.txt") Do While Not EOF(1) Line Input #1, ligne If Left(ligne, 2) = "FWP" Then ajout ligne, derlig, feuille_desti End If Loop Close #1 Application.ScreenUpdating = True End Sub Private Sub ajout(ByVal toto, ByRef derlig As Integer, ByVal F As String) Dim titi With Worksheets(F) titi = Split(toto, " ", ".") .Range(.Cells(derlig, 1), .Cells(derlig, UBound(titi) + 1)) = titi derlig = derlig + 1 End With End Sub
titi = Split(toto, " ", ".")
Sub Module1 Rem Rem Sub Importtxt() Rem Dim MyFile, MyPath, MyName Rem Dim Cell As Range Rem Application.ScreenUpdating = False Rem NomDuFichierOrigine = ActiveWorkbook.Name Rem Répertoire = ActiveWorkbook.Path & "" Rem Sheets("FeuilleDeTravail").Range("A1:A1000").Value = "" Rem CompteurFichier = 1 Rem MyFile = Dir(Répertoire & "*.txt") Rem Sheets("FeuilleDeTravail").Cells(CompteurFichier, 1) = MyFile Rem CompteurFichier = CompteurFichier + 1 Rem Do Until MyFile = "" Rem MyFile = Dir Rem If MyFile <> NomDuFichierOrigine Then Rem Sheets("FeuilleDeTravail").Cells(CompteurFichier, 1) = MyFile Rem CompteurFichier = CompteurFichier + 1 Rem End If Rem Loop Rem With Sheets("FeuilleDeTravail") Rem For Each Cell In .Range("A1:A" & .Range("A65536").End(xlUp).Row) Rem NomDuFichier = Cell Rem NomCompletDuFichierAOuvrir = Répertoire & Cell Rem Workbooks.OpenText Filename:= _ Rem NomCompletDuFichierAOuvrir, Origin:= _ Rem xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _ Rem , ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:= _ Rem False, Space:=True, Other:=True, Otherchar:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1) _ Rem , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1) _ Rem , Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), TrailingMinusNumbers _ Rem :=True Rem ActiveSheet.Range("A1:M" & ActiveSheet.Range("A65536").End(xlUp).Row).Copy Rem Workbooks(NomDuFichierOrigine).Sheets("Résultats").Range("A" & Workbooks(NomDuFichierOrigine).Sheets("Résultats").Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues Rem Application.DisplayAlerts = False Rem Workbooks(NomDuFichier).Close savechanges:=False Rem Application.DisplayAlerts = True Rem Next Rem End With Rem End Sub Rem Rem End Sub
Sub import() Dim Directory As String, File As String, Temp As String Dim NumRow As Long, NumCol As Integer Dim FF As Integer, I As Integer Dim LigFic As Long Directory = ThisWorkbook.Path & "" & "fevrier08" ' "E:\fevrier08" File = Dir(Directory & "*.txt") NumRow = ActiveCell.Row NumCol = ActiveCell.Column With ActiveSheet FF = FreeFile LigFic = 0 Do While File <> "" Open Directory & File For Input As #FF Do While Not EOF(FF) Line Input #FF, Temp If LigFic > 4 Then Table = Split(Temp, vbTab) For I = 0 To UBound(Table) If IsDate(Table(I)) Then .Cells(NumRow, NumCol + I) = CDate(Table(I)) Else .Cells(NumRow, NumCol + I) = Table(I) End If Next NumRow = NumRow + 1 End If LigFic = LigFic + 1 Loop LigFic = 0 Close #FF File = Dir Loop End With End Sub