2008-11-12 10 views

Répondre

8

Voici un code que j'ai utilisé dans un de mes projets. Cela nécessite l'ajout d'une référence au projet pour l'objet système de fichiers. Tout d'abord, cliquez sur Projet -> Références, faites défiler jusqu'à "Microsoft Scripting Runtime" et sélectionnez-le. Ensuite, vous pouvez utiliser cette fonction:

Public Sub MakePath(ByVal Folder As String) 

    Dim arTemp() As String 
    Dim i As Long 
    Dim FSO As Scripting.FileSystemObject 
    Dim cFolder As String 

    Set FSO = New Scripting.FileSystemObject 

    arTemp = Split(Folder, "\") 
    For i = LBound(arTemp) To UBound(arTemp) 
     cFolder = cFolder & arTemp(i) & "\" 
     If Not FSO.FolderExists(cFolder) Then 
      Call FSO.CreateFolder(cFolder) 
     End If 
    Next 

End Sub 
0

Comme alternative, est une fonction ici je l'ai écrit qui prend un chemin complet comprenant une lettre de lecteur si nécessaire comme paramètre. Il parcourt alors le chemin et piège le numéro d'erreur VB 76 (chemin non trouvé). Lorsque le gestionnaire d'erreur intercepte une erreur 76, il crée le dossier à l'origine de l'erreur et reprend le chemin.

 
    Public Function Check_Path(rsPath As String) As Boolean 
     Dim dPath As String 
     Dim i As Integer 
     Dim sProductName As String 

     On Error GoTo Check_Path_Error 

     If Left$(UCase$(rsPath), 2) Left$(UCase$(CurDir), 2) Then 
      ChDrive Left$(rsPath, 2) 
     End If 

     i = 3 
     Do While InStr(i + 1, rsPath, "\") > 0 
      dPath = Left$(rsPath, InStr(i + 1, rsPath, "\") - 1) 
      i = InStr(i + 1, rsPath, "\") 
      ChDir dPath 
     Loop 
     dPath = rsPath 
     ChDir dPath 

     Check_Path = True 

    Exit Function 

    Check_Path_Error: 
     If Err.Number = 76 Then  'path not found' 
      MkDir dPath    'create the folder' 
     Resume 
    Else 
     sProductName = IIf(Len(App.ProductName) = 0, App.EXEName, App.ProductName) 
     MsgBox "There was an unexpected error while verifying/creating directories." _ 
       & vbCrLf & vbCrLf & "Error: " & CStr(Err.Number) & ", " & Err.Description & ".", _ 
      vbOKOnly + vbCritical, sProductName & " - Error Creating File" 
     Check_Path = False 
    End If 

    End Function 
2

« Sans la nécessité de faire référence FileSystemObject

Public Sub MkPath(ByVal sPath As String) 
    Dim Splits() As String, CurFolder As String 
    Dim i As Long 
    Splits = Split(sPath, "\") 
    For i = LBound(Splits) To UBound(Splits) 
    CurFolder = CurFolder & Splits(i) & "\" 
    If Dir(CurFolder, vbDirectory) = "" Then MkDir CurFolder 
    Next i 
End Sub