VB6 - Ist es möglich, ein vollständiges Pfadverzeichnis zu erstellen?

Question

Ich möchte ein vollständiges Pfadverzeichnis wie "C: \ temp1 \ temp2 \ temp2" erstellen, ohne mehrere "MakeDir" für jedes Verzeichnis erstellen zu müssen. Ist das möglich?

Gibt es eine Referenz, die ich zu meinem Projekt hinzufügen kann, das diese Art von Funktion hat?

Dank

Answer 1

können Sie diese Funktionen verwenden, um die Aufgabe ein wenig leichter zu machen:

Const PATH_SEPARATOR As String = "\" 

'"' Creates a directory and its parent directories ''' 

Public Sub MakeDirectoryStructure(strDir As String) 
    Dim sTemp As String 

    If Right$(strDir, 1) = PATH_SEPARATOR Then 
     sTemp = Left$(strDir, Len(strDir) - 1) 
    Else 
     sTemp = strDir 
    End If 
    If Dir(strDir, vbDirectory) <> "" Then 
     ' Already exists.' 
    Else 
     'We have to create it' 
     On Error Resume Next 
     MkDir strDir 
     If Err > 0 Then 
     ' Create parent subdirectory first.' 
      Err.Clear 
      'New path' 
      sTemp = ExtractPath(strDir) 
      'Recurse' 
      MakeDirectoryStructure sTemp 
     End If 
     MkDir strDir 
    End If 
End Sub 


Public Function ExtractPath(strPath As String) As String 
    ExtractPath = MiscExtractPathName(strPath, True) 
End Function 


Private Function MiscExtractPathName(strPath As String, ByVal bFlag) As String 
    'The string is treated as if it contains     ' 
    'a path and file name.          ' 
    ''''''''''''''''''''''''''''''­'''''''''''''''''''''''''''''' 
    ' If bFlag = TRUE:           ' 
    '     Function extracts the path from  ' 
    '     the input string and returns it.  ' 
    ' If bFlag = FALSE:          ' 
    '     Function extracts the File name from ' 
    '     the input string and returns it.  ' 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Dim lPos As Long 
    Dim lOldPos As Long 
    'Shorten the path one level' 
    lPos = 1 
    lOldPos = 1 
    Do 
     lPos = InStr(lPos, strPath, PATH_SEPARATOR) 
     If lPos > 0 Then 
      lOldPos = lPos 
      lPos = lPos + 1 
     Else 
      If lOldPos = 1 And Not bFlag Then 
       lOldPos = 0 
      End If 
      Exit Do 
     End If 
    Loop 
    If bFlag Then 
     MiscExtractPathName = Left$(strPath, lOldPos - 1) 
    Else 
     MiscExtractPathName = Mid$(strPath, lOldPos + 1) 
    End If 
End Function   ' MiscExtractPathName' 

Ich bin mir nicht sicher, wo ich diesen Code bekam.

Answer 2

gestellt und beantwortet vor:

equivalent-of-directory-createdirectory-in-vb6

Answer 3

'//Create nested folders in one call 

Public Function MkDirs(ByVal PathIn As String) _ 
    As Boolean 
    Dim nPos As Long 
    MkDirs = True 'assume success 
    If Right$(PathIn, 1) <> "\" Then PathIn = PathIn + "\" nPos = InStr(1, PathIn, "\") 

    Do While nPos > 0 
     If Dir$(Left$(PathIn, nPos), vbDirectory) = "" Then 
      On Error GoTo Failed 
       MkDir Left$(PathIn, nPos) 
      On Error GoTo 0 
     End If 
     nPos = InStr(nPos + 1, PathIn, "\") 
    Loop 

    Exit Function 
Failed: 
    MkDirs = False 
End Function 

Answer 4

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Dim mF As String 

mF = FolderPath 

If Right(mF, 1) <> "\" Then mF = mF & "\" 

MakeSureDirectoryPathExists mF