zoukankan      html  css  js  c++  java
  • VB6 选择文件夹路径

    '---------------------------------------------------------------------------------------
    ' Module    : ModuleFile
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 文件相关操作模块
    ' Function  : 1、选取文件夹
    '---------------------------------------------------------------------------------------
     
    Option Explicit
     
    Private Type BrowseInfo
        hWndOwner 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
    Const BIF_RETURNONLYFSDIRS = 1
    Const BIF_NEWDIALOGSTYLE = &H40
    Const BIF_EDITBOX = &H10
    Const BIF_USENEWUI = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
    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
     
     
    '---------------------------------------------------------------------------------------
    ' Procedure : BrowseForFolder
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 选取文件夹(不含新建文件夹指令) 返回BrowseForFolder
    '---------------------------------------------------------------------------------------
    '
    Public Function BrowseForFolder(Optional sTitle As String = "请选择文件夹") As String
        Dim iNull As Integer, lpIDList As Long, lResult As Long
        Dim sPath As String, udtBI As BrowseInfo
     
        With udtBI
            .hWndOwner = 0 ' Me.hWnd
            .lpszTitle = lstrcat(sTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI
        End With
        lpIDList = SHBrowseForFolder(udtBI)
        If lpIDList Then
           sPath = String$(MAX_PATH, 0)
            SHGetPathFromIDList lpIDList, sPath
            CoTaskMemFree lpIDList
           iNull = InStr(sPath, vbNullChar)
            If iNull Then
              sPath = Left$(sPath, iNull - 1)
            End If
        End If
     
        BrowseForFolder = sPath
    End Function
     
     
    '---------------------------------------------------------------------------------------
    ' Procedure : BrowseForFolder1
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 选取文件夹路径(含新建文件夹) 返回BrowseForFolder1 字符串
    '---------------------------------------------------------------------------------------
    '
    Public Function BrowseForFolder1(Optional sTitle As String = "请选择文件夹") As String
        Dim iNull As Integer, lpIDList As Long, lResult As Long
        Dim sPath As String, udtBI As BrowseInfo
     
        With udtBI
            .hWndOwner = 0 ' Me.hWnd
            .lpszTitle = lstrcat(sTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS
        End With
        lpIDList = SHBrowseForFolder(udtBI)
        If lpIDList Then
           sPath = String$(MAX_PATH, 0)
            SHGetPathFromIDList lpIDList, sPath
            CoTaskMemFree lpIDList
           iNull = InStr(sPath, vbNullChar)
            If iNull Then
              sPath = Left$(sPath, iNull - 1)
            End If
        End If
     
        BrowseForFolder1 = sPath
    End Function
    

      

    在主窗体中可以插入按钮。添加下述代码,其中前一个没有新建文件夹功能,后一个有新建文件夹功能

    Option Explicit
    
    Private Sub Command1_Click()
    Dim path1 As String
    path1 = BrowseForFolder
    MsgBox path1
    End Sub
    
    Private Sub Command2_Click()
    Dim path As String
    path = BrowseForFolder1
    MsgBox path
    End Sub
    

      

  • 相关阅读:
    字符串初始化、查找字符+获取字符
    冒泡排序
    JAVA中值类型和引用类型的不同?
    二维数组初始化,属性,遍历,输出各元素总和。
    数组定义属性遍历循环,输出最大数
    for穷举,叠代练习
    HTML--Boby部分之<a>标签
    HTML--Boby内标签之多行文本及下拉框
    HTML--Boby部分Input之重置
    HTML--Boby部分Input之上传文件
  • 原文地址:https://www.cnblogs.com/wgscd/p/9323334.html
Copyright © 2011-2022 走看看