TRAITER UNE LIGNE CSV

Commentaire de boillm le 16/10/2009 17:34:45

Perso, j'ai adapté le code pour qu'il corresponde à mes attentes (gestion d'un délimiteur de String, trim des champs, retour = nb de champs)

Utilisation :
Dim Valeurs() As String
Dim NbElement As Long
NbElement = GetLignCSV("a, b, ""c"", ""d1,d2"", e", Valeurs, ",", """")

Retour :
Valeurs = [a; b; c; d1,d2; e]

Voici le code modifié :

Public Function GetLignCSV(ByVal Ligne As String, ByRef ptrElements() As String, Optional ByVal Separator As String = ",", Optional ByVal StringDelimitor As String = """", Optional ByVal EscapeChar As String = "\") As Long
On Error GoTo erreur
Dim Getting, EscapeMode, InString As Boolean
Dim strBuffer, uChar As String
Dim i, nElement As Long
'Sortie si parametres invalides
If Len(Ligne) = 0 Or Len(EscapeChar) <> 1 Or (Len(StringDelimitor) <> 1 And Len(Separator) <> 1) Then
   GetLignCSV = -1
   Exit Function
End If

'Traitement de la ligne
For i = 1 To Len(Ligne) Step 1
   uChar = Mid$(Ligne, i, 1)
   If EscapeMode And Getting Then
      strBuffer = strBuffer & uChar
      EscapeMode = False
   Else 'If Getting Then
      Select Case uChar
         Case StringDelimitor
            If InString Then
                InString = False
            Else
                InString = True
            End If
         Case Separator
            If InString Then
                strBuffer = strBuffer & uChar
            Else
                ReDim Preserve ptrElements(nElement): ptrElements(nElement) = Trim$(strBuffer)
                nElement = nElement + 1: strBuffer = ""
            End If
         Case EscapeChar
            EscapeMode = True
         Case Else
            strBuffer = strBuffer & uChar
      End Select
   End If
Next i
'Recuperation du dernier element si necessaire
If Len(strBuffer) > 0 And Len(Separator) = 1 Then
   ReDim Preserve ptrElements(nElement): ptrElements(nElement) = Trim$(strBuffer)
   nElement = nElement + 1: strBuffer = ""
End If
GetLignCSV = nElement
Exit Function
erreur:
MsgBox "Une erreur est inopinément survenue !" & vbCrLf & "Code erreur : " & CStr(Err.Number) & vbCrLf & Err.Description
End Function