- Public Function RepertoireCreation(ByVal RptChm As String) As Boolean
- '
- Dim RptTbl() As String
- Dim Niveau As Integer
- Dim Trouve As Boolean
- Dim TmpTbl() As String
- Dim TmpAtr As Integer
- '
- On Error Resume Next
- RptTbl = Split(RptChm, "\")
-
- Trouve = False
- Niveau = UBound(RptTbl)
- While ((Niveau >= 0) And (Not Trouve))
-
- TmpTbl = RptTbl
- ReDim Preserve TmpTbl(0 To Niveau)
- RptChm = Join(TmpTbl, "\")
-
- Err.Clear
- TmpAtr = GetAttr(RptChm)
- If (Err.Number = 0) Then
- If ((TmpAtr And vbDirectory) = vbDirectory) Then
- Trouve = True
- Else
- Niveau = 0
- End If
- End If
-
- If (Not Trouve) Then
- Niveau = Niveau - 1
- End If
-
- Wend
-
- If ((Trouve) And (Niveau < UBound(RptTbl))) Then
-
- While ((Niveau < UBound(RptTbl)) And (Trouve))
-
- Niveau = Niveau + 1
- TmpTbl = RptTbl
- ReDim Preserve TmpTbl(0 To Niveau)
- RptChm = Join(TmpTbl, "\")
-
- MkDir RptChm
-
- Trouve = (Err.Number = 0)
-
- Wend
-
- End If
-
- RepertoireCreation = Trouve
-
- End Function
-
-
Public Function RepertoireCreation(ByVal RptChm As String) As Boolean
'
Dim RptTbl() As String
Dim Niveau As Integer
Dim Trouve As Boolean
Dim TmpTbl() As String
Dim TmpAtr As Integer
'
On Error Resume Next
RptTbl = Split(RptChm, "\")
Trouve = False
Niveau = UBound(RptTbl)
While ((Niveau >= 0) And (Not Trouve))
TmpTbl = RptTbl
ReDim Preserve TmpTbl(0 To Niveau)
RptChm = Join(TmpTbl, "\")
Err.Clear
TmpAtr = GetAttr(RptChm)
If (Err.Number = 0) Then
If ((TmpAtr And vbDirectory) = vbDirectory) Then
Trouve = True
Else
Niveau = 0
End If
End If
If (Not Trouve) Then
Niveau = Niveau - 1
End If
Wend
If ((Trouve) And (Niveau < UBound(RptTbl))) Then
While ((Niveau < UBound(RptTbl)) And (Trouve))
Niveau = Niveau + 1
TmpTbl = RptTbl
ReDim Preserve TmpTbl(0 To Niveau)
RptChm = Join(TmpTbl, "\")
MkDir RptChm
Trouve = (Err.Number = 0)
Wend
End If
RepertoireCreation = Trouve
End Function