Sub lireFichier_ri()
Dim Ligne As String
Dim LePath As String, LaDate As String
Dim Fich As String, X As String
Dim Flag As Boolean
Dim Tblo(0 To 7)
Application.ScreenUpdating = False
Columns(1).Clear
LePath = ThisWorkbook.Path & "\"
Fich = Dir(LePath & "*.ri")
X = LePath & Fich
Do While Fich <> ""
Open X For Input As #1
Do While Not EOF(1)
Line Input #1, Ligne
If Not Flag Then
Tblo(1) = Mid(Ligne, InStr(1, Ligne, "<") + 1, InStr(1, Ligne, ">") - InStr(1, Ligne, "<") - 1)
Flag = True
ElseIf Trim(Ligne) Like "USER LABEL*" Then
Tblo(0) = "/" & Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, "/")))
ElseIf Trim(Ligne) Like "LOCATION NAME*" Then
Tblo(2) = Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, ":")))
ElseIf Trim(Ligne) Like "Unit type*" Then
Tblo(3) = Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, ":")))
ElseIf Trim(Ligne) Like "Unit part number*" Then
If Mid(Ligne, InStr(1, Ligne, ":") + 2, 3) = "3AL" Or _
Mid(Ligne, InStr(1, Ligne, ":") + 2, 3) = "3AL" Then
Tblo(4) = Left(Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, ":"))), 10)
Tblo(5) = Trim(Right(Ligne, 4))
Else
Tblo(4) = Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, ":")))
Tblo(5) = ""
End If
ElseIf Trim(Ligne) Like "Serial number*" Then
Tblo(6) = Trim(Right(Ligne, Len(Ligne) - InStr(1, Ligne, ":")))
ElseIf Trim(Ligne) Like "Date*" Then
LaDate = Right(Ligne, 8)
Tblo(7) = CDate(Right(LaDate, 2) & "/" & Mid(LaDate, 4, 2) & "/" & Left(LaDate, 2))
[A65000].End(xlUp)(2) = Join(Tblo, ";")
End If
Loop
Close #1
Fich = Dir
Flag = False
Loop
Columns("A").AutoFit
Rows(1).Delete
Sheets(1).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=LePath & "carte.csv", FileFormat:=xlCSV
ActiveWorkbook.Close
End Sub
