zoukankan      html  css  js  c++  java
  • 查找文件夹

    Option Explicit
       
      Private Type BrowseInfo
              lngHwnd                 As Long
              pIDLRoot               As Long
              pszDisplayName   As Long
              lpszTitle             As Long
              ulFlags                 As Long
              lpfnCallback       As Long
              lParam                   As Long
              iImage                   As Long
      End Type
       
      Private Const BIF_RETURNONLYFSDIRS = 1
    ‘Private Const BIF_RETURNONLYFSDIRS = 100-----〉多一个新建文件夹的按钮
      Private Const MAX_PATH = 260
       
      Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
              (ByVal hMem As Long)
       
      Private Declare Function lstrcat Lib "Kernel32" _
            Alias "lstrcatA" (ByVal lpString1 As String, _
            ByVal lpString2 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 Long
       
      Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String
       
              On Error GoTo ehBrowseForFolder         'Trap   for   errors
       
              Dim intNull     As Integer
              Dim lngIDList     As Long, lngResult       As Long
              Dim strPath     As String
              Dim udtBI     As BrowseInfo
       
              'Set   API   properties   (housed   in   a   UDT)
              With udtBI
                      .lngHwnd = lngHwnd
                      .lpszTitle = lstrcat(strPrompt, "")
                      .ulFlags = BIF_RETURNONLYFSDIRS
              End With
       
              'Display   the   browse   folder...
              lngIDList = SHBrowseForFolder(udtBI)
       
              If lngIDList <> 0 Then
                      'Create   string   of   nulls   so   it   will   fill   in   with   the   path
                      strPath = String(MAX_PATH, 0)
       
                      'Retrieves   the   path   selected,   places   in   the   null
                        'character   filled   string
                      lngResult = SHGetPathFromIDList(lngIDList, strPath)
       
                      'Frees   memory
                      Call CoTaskMemFree(lngIDList)
       
                      'Find   the   first   instance   of   a   null   character,
                        'so   we   can   get   just   the   path
                      intNull = InStr(strPath, vbNullChar)
                      'Greater   than   0   means   the   path   exists...
                      If intNull > 0 Then
                              'Set   the   value
                              strPath = Left(strPath, intNull - 1)
                      End If
              End If
       
              'Return   the   path   name
              BrowseForFolder = strPath
              Exit Function     'Abort
       
    ehBrowseForFolder:
       
              'Return   no   value
              BrowseForFolder = Empty
       
      End Function
     
       
      Private Sub Command1_Click()
              Debug.Print BrowseForFolder(Me.hWnd, "a")
      End Sub
  • 相关阅读:
    mysql用户
    mysql字符集
    tidb之一致性算法raft学习
    更新港资股票数据
    php中的时区设置
    PHP 中的注释
    python下如何处理windows的路径名
    安装第三方模块
    偏函数
    装饰器没学明白,记录一下,以后再学
  • 原文地址:https://www.cnblogs.com/Charlotte/p/530609.html
Copyright © 2011-2022 走看看