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'

我不确定我在哪里获得此代码。

Answer 2

之前被问到并回答：

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
End If

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

4 个答案: