VB6 - 是否可以创建完整路径目录？

Question

我想为每个目录创建一个完整路径目录，例如“C:\temp1\temp2\temp2”，而不必创建多个“MakeDir”。这可能吗？

有没有我可以添加到具有这种功能的项目的引用？

谢谢

Answer 1

您可以使用这些功能使任务更轻松:

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'

我不确定我从哪里得到这个代码。