救急，关于目录问题

Question

如何判断一个目录的存在？，如果没有如何建立目录？，然后在vb中用方法打开资源管理器并打开指定的目录？

Answer 1

创建多级目录可用API函数来实现：
模块中内容：
Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long窗体代码窗口内容：
Public Sub CreateNewDirectory(NewDirectory As String)
    Dim sDirTest As String
    Dim SecAttrib As SECURITY_ATTRIBUTES
    Dim bSuccess As Boolean
    Dim sPath As String
    Dim iCounter As Integer
    Dim sTempDir As String
    iFlag = 0
    sPath = NewDirectory
    If Right(sPath, Len(sPath)) <> "\" Then
        sPath = sPath & "\"
    End If
    iCounter = 1
    '循环逐级建立目录。
    Do Until InStr(iCounter, sPath, "\") = 0
        '提取目录结构。
        iCounter = InStr(iCounter, sPath, "\")
        sTempDir = Left(sPath, iCounter)
        sDirTest = Dir(sTempDir)
        iCounter = iCounter + 1
        '创建目录。
        SecAttrib.lpSecurityDescriptor = &O0
        SecAttrib.bInheritHandle = False
        SecAttrib.nLength = Len(SecAttrib)
        bSuccess = CreateDirectory(sTempDir, SecAttrib)
    LoopEnd Sub
Private Sub Command1_Click()
    Call CreateNewDirectory(Text1.Text)
End Sub

Answer 2

'
'建立文件夹
'函数:CreateDir
'参数: DirPath 新建文件夹路径.
'返回值:=T 成功,=F 失败.
Public Function CreateDir(DirPath As String) As Boolean
     Dim c As String
     Dim A As Long
     Dim LeftName As String
     
     On Error Resume Next
     
     c = Trim$(DirPath)
     If Len(c) < 2 Then Err.Number = -1: GoTo Errhan
     If Dir$(Left$(c, 2), vbDirectory) = "" Then Err.Number = -1: GoTo Errhan '根目录是否存在
     '/-------------------------------------------------------
     If Right$(c, 1) <> "\" Then c = c & "\"
     For A = 1 To Len(c)
         If Mid$(c, A, 1) = "\" Then
            LeftName = Left$(c, A)
            If Dir$(LeftName, vbDirectory + vbHidden) = "" Then MkDir LeftName: DoEvents
         End If
     Next A
Errhan:
     If Err.Number = 0 Then
        Err.Clear
        CreateDir = True
     Else
        Err.Clear
        CreateDir = False
     End If
End Function

Answer 3

'*在资源管理器中打开文件目录Option Explicit
'/常量定义
'/程序的显示方式
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOW = 5
Private Const SW_HIDE = 0
Private Const SW_MINIMIZE = 6
Private Const SW_MAXIMIZE = 3
Private Const SW_RESTORE = 9Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                       (ByVal hWnd As Long, ByVal lpOperation As String, _
                        ByVal lpFile As String, ByVal lpParameters As String, _
                        ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Command1_Click()
      ShellExecute Me.hWnd, "Open", "C:\", "", "C:\", SW_MAXIMIZE
End Sub

Answer 4

还可以FSO来操作。
http://b4018.xici.net（新任版主，欢迎光临。）
提供：VB、VBA、Office二次开发免费技术支持；
承接：各类项目开发，如MIS系统，WEB网站，中小型应用软件等等；CO.：Vansoft Workroom
MSN：[email protected]
Email：[email protected]
       [email protected]
TEL：[phone]（范，24H）

Answer 5

首先在"工程"--"引用"中引用"Microsoft Scripting Runtime"
Dim fsoTest As New FileSystemObjectIf fsoTest.FolderExists(App.Path & "\Data") = False Then '如果些文件夹不存在就新建一个
    fsoTest.CreateFolder (App.Path & "\Data")
End If

Answer 6

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Command1_Click()
    If Len(Dir("C:\aa")) = 0 Then '文件不存在
        Call MkDir("C:\aa") '创建目录
        ShellExecute Me.hwnd, "open", "C:\aa", vbNullString, vbNullString, 1
    End If
End Sub

Answer 7

对于此类问题，我还是推荐Fso，代码如下：1
'判断是否存在
Set fso = CreateObject("Scripting.FileSystemObject")
AimFolder = inputbox("输入你想查询的文件夹路径")
cc = fso.folderexists(aimfolder)
if cc = true then 
  msgbox "文件夹" & aimfolder &  "存在"
else
  msgbox "文件夹" & aimfolder & "不存在"  
end if2
'如果不存在，则创建该文件夹
if cc= false then
  kk=msgbox("该文件夹不存在，你是否想创建该文件夹",vbyesno)
  if kk =vbyes then
    Set f = fso.CreateFolder(aimfolder)
  end if
end if3
'打开文件夹
on error resume next
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run aimfolder

Answer 8

tmp="c:\test"
if dir(tmp,vbDirectory)="" then
   mkdir tmp
end ifon error resume next
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run tmp