Condition pour supprimer les underscores VBA

Bonjour,

J’ai un répertoire dans lequel sont déposés des fichiers format PDF ainsi qu'un bordereau de suivit format Excel.

Les fichiers PDF sont nommés Nom_Prénom_Date_numéro.pdf

Le bordereau format Excel (VBA) me permet d'avoir la liste totale des PDF, afin de faciliter son alimentation (Nom ; Prénom. Date) , j’ai créé une VBA. En un seul clic les données sont renseignées.

Le problème est que les underscores présents dans le nommage du PDF me bloque l’alimentation.

En effet , sur un fichier PDF nommé NOM Prénom Date Numéro pdf ça fonctionne.

Mais depuis peu les fichiers importés sont nommés avec des underscore Nom_Prénom_Date_numéro.pdf.

De ce fait au lieu d’avoir 4 éléments j’en ai qu’un puisque l’underscore compile le nommage.

Ma question est existe-t-il une condition à mettre dans la VBA ci joinnt et ci-dessous.

Merci

Sub Import()

Application.ScreenUpdating = False

Dim myPath As String, myFolder As String, myFile As String

myPath = ThisWorkbook.Path

myFolder = Dir(myPath & "\*", vbDirectory)

i = 1

c = 16

Range("A16:J141").Value = ""

' Lit les noms des dossiers

'Do While myFolder <> ""

' If GetAttr(myPath & "\" & myFolder) = vbDirectory Then

' i = i + 1

' Cells(c, 2) = myFolder

' Cells(c, 1) = i

' c = c + 1

' End If

' myFolder = Dir()

'Loop

' liste les fichiers

myFile = Dir(myPath & "\*.pdf", vbDirectory)

Do While myFile <> ""

infos = Split(myFile, " ")

Cells(c, 1) = i

Cells(c, 2) = infos(3)

Cells(c, 3) = infos(4)

Cells(c, 4) = infos(0)

c = c + 1

i = i + 1

myFile = Dir()

Loop

Cells(10, 3) = i - 1

If (i = 0) Then

MsgBox ("Aucun dossier/fichier n'est présent dans le répertoire.")

End If

End Sub

Bonjour colnago4

Quand vous donnez du code, merci de le mettre entre balises avec le bouton < />

Sinon remplacez l'espace de votre SPLIT() par l'underscore

infos = Split(myFile, "_")

Nota : Il est dommage d'utilise VBA et ne pas savoir ce que cela fait exactement !

merci et merci pour ce retour

mais ça fonctionne pas

Re,

Je n'ai pas fait attention, mais je ne vois pas comment cela pouvait marcher avant

Il faut modifier les numéros des infos

        infos = Split(myFile, "_")
        Cells(c, 1) = i
        Cells(c, 2) = infos(0)
        Cells(c, 3) = infos(1)
        Cells(c, 4) = infos(2)

A+

re,

Sub Import()
     Application.ScreenUpdating = False
     Dim myPath As String, myFile As String

     myPath = ThisWorkbook.Path
     i = 1: c = 16
     Range("A16:J141").Value = ""

     ' liste les fichiers
     myFile = Dir(myPath & "\*.pdf", vbDirectory)     'vbNormal ou vbDirectory ???

     Do While myFile <> ""
          infos = Split(Left(myFile, Len(myFile) - 4), "_")
          If UBound(infos) <> 2 Then
               MsgBox "il n'y a pas 3 chaines", vbInformation, myFile
          Else
               'Debug.Print i, myFile
               Cells(c, 1) = i
               Cells(c, 2) = infos(1)
               Cells(c, 3) = infos(2)
               Cells(c, 4) = infos(0)
               c = c + 1
               i = i + 1
          End If
          myFile = Dir()
     Loop

     Cells(10, 3) = i - 1

     If (i = 0) Then
          MsgBox ("Aucun dossier/fichier n'est présent dans le répertoire.")
     End If
End Sub

EDIT: Trop tard,JExceL2Fr (salut) avait déjà donné la solution ...

C'est nickel

merci