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' 

我不知道在那里我得到这个代码。

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

私人声明函数库MakeSureDirectoryPathExists “IMAGEHLP.DLL”（BYVAL lpPath作为字符串），只要

Dim mF As String 

mF = FolderPath 

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

MakeSureDirectoryPathExistsμF的