Private Sub ImportTxtTabDate()
Dim Source As String, Destination As String
Dim FileNumber As Integer, cpt As Integer
Dim Chaine As String
Dim i As Integer, Pos As Integer, NbCol As Integer
Dim ar() As String
Const Dossier As String = "C:\Transfert"
Source = Dossier & "\" & "Essai.txt"
Destination = Dossier & "\" & "Essai_Copie.txt"
FileCopy Source, Destination
FileNumber = FreeFile
Source = Destination
Open Source For Input As #FileNumber
Line Input #FileNumber, Chaine
ar() = Split(Chaine, vbTab)
NbCol = UBound(ar())
Close #FileNumber
Cells.Clear
cpt = 1
Open Source For Input As #FileNumber
Do While Not EOF(FileNumber)
Line Input #FileNumber, Chaine
ar() = Split(Chaine, vbTab)
For i = 0 To NbCol
Pos = InStr(ar(i), "." )
If IsNumeric(ar(i)) Then
Cells(cpt, i + 1) = CDbl(ar(i))
ElseIf Pos > 0 Then
Cells(cpt, i + 1) = ar(i)
ElseIf IsDate(ar(i)) Then
Cells(cpt, i + 1) = CDate(ar(i))
End If
Next
cpt = cpt + 1
Loop
Close #FileNumber
Cells(1, NbCol + 2).Select
End Sub
|
