Option Explicit
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Sub Tst()
Dim LastRow As Long
Dim i As Long
Dim sDossier As String
Dim sDossier1 As String
Dim sDossier2 As String
Dim sDossier3 As String
LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
sDossier1 = Feuil1.Range("A" & i)
sDossier2 = Feuil1.Range("B" & i)
sDossier3 = Feuil1.Range("C" & i)
sDossier = "C:\" & sDossier1 & "\" & sDossier2 & "\" & sDossier3
If NomValide(sDossier1) And NomValide(sDossier2) And NomValide(sDossier3) Then
CreationDossier sDossier
Feuil1.Range("D" & i).Interior.ColorIndex = xlNone
Else
Feuil1.Range("D" & i).Interior.ColorIndex = 3
End If
Next i
End Sub
Private Sub CreationDossier(sDossier As String)
Dim Rep As Long
Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Sub
Private Function NomValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
NomValide = True
For i = 1 To Len(CaracInterdits)
If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
NomValide = False
Exit Function
End If
Next i
End Function