查找目录

Question

怎样在vb中选定一个目录？
可以处理目录中所有的文件

Answer 1

to:xayzmb(行者) 
  要可是化的，让顾客自己选择

Answer 2

选择目录的函数如下：
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                                     ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
                                     ByVal lpBuffer As String) As LongPrivate Type BrowseInfo
  hWndOwner      As Long
  pIDLRoot       As Long
  pszDisplayName As Long
  lpszTitle      As String
  ulFlags        As Long
  lpfnCallback   As Long
  lParam         As Long
  iImage         As Long
End TypePrivate m_CurrentDirectory As String'====================== 选择目录的函数 ========================================================================
'Owner ----------- 调用该函数的窗体
'Title ----------- 显示在目录选择对话框上的标题 (可选)
'StarDir --------- 默认打开的目录 (可选)
Public Function BrowseForFolder(Owner As Form, Optional Title As String, Optional StartDir As String) As String  Dim lpIDList As Long
  Dim szTitle As String
  Dim sBuffer As String
  Dim tBrowseInfo As BrowseInfo
  m_CurrentDirectory = StartDir & vbNullChar  szTitle = Title
  With tBrowseInfo
    .hWndOwner = Owner.hWnd
    .lpszTitle = IIf(Title <> "", Title, "路径选择：")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
    If StartDir <> "" Then
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End If
  End With  lpIDList = SHBrowseForFolder(tBrowseInfo)
  If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    BrowseForFolder = sBuffer
  Else
    BrowseForFolder = ""
  End If
  
End Function
 
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
  
  On Error Resume Next
  
  Select Case uMsg
  
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
      
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
      
  End Select
  
  BrowseCallbackProc = 0
  
End FunctionPrivate Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

Answer 3

查找文件的函数如下：
'============= 查找指定目录下指定类型的文件 ============================
'SearchPath --------- 要查找的目录
'SearchType --------- 要查找文件类型的后缀名
'SearchedFiles() ---- 存放查找到的文件名的字符型数组。
'返回值 ------------- True为执行成功，False为没有找到或失败.
Public Function SearchFiles(SearchPath As String, SearchType As String, _
                             SearchedFiles() As String) As Boolean
Dim strTemp As String
Dim FileCount As LongstrTemp = Dir(SearchPath + SearchType, vbHidden + vbArchive + vbReadOnly + vbSystem)If strTemp <> "" Then
   If myBound(SearchedFiles) = -1 Then  '如果该数组为空,则从0开始计数
   FileCount = -1
   ElseIf myBound(SearchedFiles) = -2 Then
   MsgBox "SearchedFiles()参数不是一个数组，无法执行！", vbCritical
   Else
   FileCount = UBound(SearchedFiles)    '如果该数组中有其它的数据，则接下去计数
   End If
   
   Do
   FileCount = FileCount + 1
   ReDim Preserve SearchedFiles(FileCount)
   SearchedFiles(FileCount) = SearchPath + strTemp
   strTemp = Dir()
   Loop Until strTemp = ""
SearchFiles = True
Else
SearchFiles = False
End IfEnd Function'判断数组是否为空的函数，如果为空则返回-1，如果不是数组返回-2，否则返回数组是变量的个数
'FindFiles的辅助函数
Private Function myBound(TestV As Variant) As Long
On Error GoTo 10
myBound = UBound(TestV) - LBound(TestV) + 1
Exit Function10:
If Err.Number = 9 Then
myBound = -1
Else
myBound = -2
End If
End Function

Answer 4

Option Explicit
Dim m_lngFileCount As Long '注释：定义计数器
Dim m_objFSO As Scripting.FileSystemObject '注释：定义文件系统对象Sub CheckFolder(strPath As String)    Dim objFolder As Scripting.Folder '注释：文件夹对象
    Dim objFile As Scripting.File '注释：文件对象
    Dim objSubdirs As Scripting.Folders '注释：文件夹集合对象
    Dim objLoopFolder As Scripting.Folder '注释：文件夹对象
    Label2.Caption = "Checking directory " & strPath
    Set objFolder = m_objFSO.GetFolder(strPath)
    
    '注释:  检查目录中的文件
    For Each objFile In objFolder.Files        If UCase$(Right$(objFile.Path, 4)) = ".gif" Or UCase$(Right$(objFile.Path, 4)) = ".GIF" Then
        '注释：这一段是条件检查，但找到的文件是否符合给定的条件，这儿通过取文件名的
        '注释：最后4位看是不是“.GIF“来判断文件是否是GIF文件。
            m_lngFileCount = m_lngFileCount + 1
'*********************************************           
'在这里加文件操作
'*********************************************            
             '注释：找到指定条件的文件后进行相应的操作，这儿是把计数器加一。
        End If
    Next objFile
    
    Set objSubdirs = objFolder.SubFolders
    For Each objLoopFolder In objSubdirs
        CheckFolder objLoopFolder.Path
    '注释：递归调用CheckFolder子过程，实现目录树的遍历。
    Next objLoopFolder
    
    Set objSubdirs = Nothing
    Set objFolder = NothingEnd Sub

Answer 5

核心语句:
    Dim fso As New FileSystemObject, fs As Folder, fileObj As File
        Set fs = fso.GetFolder("你的目录")
        For Each fileObj In fs.Files
           If fileObj.Type = "Internet E-Mail Message" Or fileObj.Type = "Outlook Item" Then
                FileName = fileObj.Name
                .....your work...           End If
        Next