VB 6.0对于选择文件和文件夹的基础操作和代码 【快速复制本文链接】

    2018-5-10 10:22 | 2018-5-10/10:28
400 ° 来自:PC

VB6.0打开对话框选择文件的方法


先添加CommonDialog控件
Private Sub Command1_Click()
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
End Sub


VB6.0打开对话框选择文件夹或盘符的方法


在窗体中添加两个按钮和一个文本框

Option Explicit  
  
Private Sub Command1_Click()  
    Dim path1 As String  
    path1 = BrowseForFolder   '这个对话框中带【新建文件夹】功能
    text1 = path1  
End Sub  
  
Private Sub Command2_Click()  
    Dim path As String  
    path = BrowseForFolder1     '这个对话框中不带新建文件夹功能
    text1 = path  
End Sub 

新建一个模块,写入下列代码

'---------------------------------------------------------------------------------------  
' 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


上一篇: 折腾9旬老人,湖北红安社保部门没有理由站得住
下一篇: VB 6.0对于注册表的写和读的基础代码
您可能还喜欢这些:

亲,沙发正空着,还不快来抢?

欢迎在下面留言

记住我的个人信息
Back to Top