VBA vérifier des noms

Bonjour à tous,

J'ai encore un souci en VBA, toujours pour vérifier que les noms des fichiers sont bien normalisés...

voici ma macro:

Sub test2()
'********************************************************
'déclaration des variables
Dim confirmations1 As Range
Dim Confirmations As String
Dim Mylen
Dim SICO
Dim RefBO
Dim DateRefBO

'selection de la lettre réseau
Sheets("paramétrages").Select
Range("B4").Select

'si la cellule active = "", erreur
If ActiveCell = "Lettre réseau" Then
MsgBox ("entrez votre lettre réseau...")
arret = True
Else
Sheets("paramétrages").Select
Range("B4").Select

'********************************************************
'repertoire = la valeur en C13 de la page paramtrages
repertoire = [C2]

'utilisation de l'outil filsearch d'Excel
With Application.FileSearch

'répertoire des conf
.LookIn = repertoire

'nom et type de fichier
.Filename = "*.pdf"

'executer la macro
.Execute

'les mettre les uns en dessous des autres
Sheets("fichiers trouvés").Select
For i = 1 To .FoundFiles.Count
Cells(i + 5, 1) = .FoundFiles(i)
Next

'********************************************************
'convertir les données
    'oter l'adresse réseau
    Range("A6").Select

    Range(ActiveCell, ActiveCell.End(xlDown)).Select

    Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, _
        9), Array(6, 1)), TrailingMinusNumbers:=True

    'oter le .pdf
    Range("A6").Select

    Range(ActiveCell, ActiveCell.End(xlDown)).Select

    Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
    Range("A6").Select

'clear B:B
Range("B:B").Clear

'***********************************************************
'Vérifier les noms de fichiers

'Confirmations =
Mylen = Len(CStr(SICO)) = 10
Mylen = Len(CStr(RefBO)) = 12
Mylen = Len(CStr(DateRefBO)) = 6

Confirmations = DateRefBO & "_" & SICO & "_" & RefBO

Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

For Each confirmations1 In Selection
If Len(confirmations1) = Len(Confirmations) Then

Else
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)

End If
Next confirmations1
End With
End If
End Sub

Comme vous l'aurez compris, j'ai un souci dans la partie:

'***********************************************************
'Vérifier les noms de fichiers

'Confirmations =
Mylen = Len(CStr(SICO)) = 10
Mylen = Len(CStr(RefBO)) = 12
Mylen = Len(CStr(DateRefBO)) = 6

Confirmations = DateRefBO & "_" & SICO & "_" & RefBO

Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

For Each confirmations1 In Selection
If Len(confirmations1) = Len(Confirmations) Then

Else
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)

End If
Next confirmations1
End With
End If
End Sub

Je souhaiterais vérifier que chaque noms dans la selection fait bien 30 caractères et qu'elle soit bien du type YYMMDD_10chiffres_ 3 lettres + 9 chiffres

Merci à celui qui m'aidra,

c bon, j'ai trouvé... ça fait quelques jours que je suis dessus et il a fallu que je poste pour que je trouve... j'ai un peu simplifié...:

Sub test1()
'********************************************************
'déclaration des variables
Dim confirmations1 As Range
Dim Confirmations As String * 30
Dim Mylen, Mystring

'selection de la lettre réseau
Sheets("paramétrages").Select
Range("B4").Select

'si la cellule active = "", erreur
If ActiveCell = "Lettre réseau" Then
MsgBox ("entrez votre lettre réseau...")
arret = True
Else
Sheets("paramétrages").Select
Range("B4").Select

'********************************************************
'repertoire = la valeur en C13 de la page paramtrages
repertoire = [C2]

'utilisation de l'outil filsearch d'Excel
With Application.FileSearch

'répertoire des conf
.LookIn = repertoire

'nom et type de fichier
.Filename = "*.pdf"

'executer la macro
.Execute

'les mettre les uns en dessous des autres
Sheets("fichiers trouvés").Select
For i = 1 To .FoundFiles.Count
Cells(i + 5, 1) = .FoundFiles(i)
Next

'********************************************************
'convertir les données
    'oter l'adresse réseau
    Range("A6").Select

    Range(ActiveCell, ActiveCell.End(xlDown)).Select

    Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, _
        9), Array(6, 1)), TrailingMinusNumbers:=True

    'oter le .pdf
    Range("A6").Select

    Range(ActiveCell, ActiveCell.End(xlDown)).Select

    Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
    Range("A6").Select

'clear B:B
Range("B:B").Clear

'**********************************************************************************
'vérifier les noms
' def RefBo
Mylen = Len(Confirmations)

'si confirmation ne correspond pas à ça alors FAUX
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

For Each confirmations1 In Selection
If Len(confirmations1) <> 30 Then
ActiveCell.Copy
ActiveCell.Offset(0, 1).Activate
ActiveCell.Offset.PasteSpecial (xlPasteAll)
ActiveCell.Offset(1, -1).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Next confirmations1
End With
End If
End Sub
Rechercher des sujets similaires à "vba verifier noms"