如何用api打开一个多选对话框？非单选。

Question

网上的api代码都是弹出选择文件对话框，就只能选择一个文件。手动添加上&H200标记可以多选，但是选择界面就变成很古老的那种多选界面了。请问有没有好点的？？谢谢！

Answer 1

Private Sub Command1_Click()
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "All Files|*.*"
    CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
    CommonDialog1.Action = 1
  
    Dim s As String
    s = CommonDialog1.FileName
    Dim arr
    arr = Split(s, Chr(0)) '不同的系统分割符可能不同，我这是在2000下
    Dim path As String
    Dim file1 As String
    Dim i As Long
    i = InStrRev(arr(0), "\")
    List1.Clear
    If i > 0 Then
        path = Left(arr(0), i - 1)
        If UBound(arr) >= 1 Then
            For i = 1 To UBound(arr)
                List1.AddItem path + "\" + arr(i)
            Next
        Else
            List1.AddItem s
        End If
    End If
End Sub

Answer 2

谢谢先，但是我找的是用api打开对话框，不是用控件。

Answer 3

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Sub Form_Load()
 
    Dim OFName As OPENFILENAME
    OFName.lStructSize = Len(OFName)
    'Set the parent window
    OFName.hwndOwner = Me.hWnd
    'Set the application's instance
    OFName.hInstance = App.hInstance
    'Select a filter
    OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    'create a buffer for the file
    OFName.lpstrFile = Space$(254)
    'set the maximum length of a returned file
    OFName.nMaxFile = 255
    'Create a buffer for the file title
    OFName.lpstrFileTitle = Space$(254)
    'Set the maximum length of a returned file title
    OFName.nMaxFileTitle = 255
    'Set the initial directory
    OFName.lpstrInitialDir = "C:\"
    'Set the title
    OFName.lpstrTitle = "Open File "
    'No flags
    OFName.flags = &H200    'Show the 'Open File'-dialog
    If GetOpenFileName(OFName) Then
        MsgBox "File to Open: " + Trim$(OFName.lpstrFile)
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub

Answer 4

还是自己用
DriveListBox
DirListBox
FileListBox
作界面比较好，想做什么样就什么样

Answer 5

Private Sub FileOpen_Click()
    Dim ofn As OPENFILENAME
    Dim rtn As String    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = Me.hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "所有文件"
    ofn.lpstrFile = Space(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = App.Path
    ofn.lpstrTitle = "打开文件"
    ofn.flags = &H80000 + &H200   '注意这里
    rtn = GetOpenFileName(ofn)    If rtn >= 1 Then
        Filename.Text = ofn.lpstrFile
    Else
        Filename.Text = "Cancel Was Pressed"
    End If
End Sub模块
Option ExplicitDeclare Function GetOpenFileName Lib "comdlg32.dll" Alias _
        "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Type OPENFILENAME
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     lpstrFilter As String
     lpstrCustomFilter As String
     nMaxCustFilter As Long
     nFilterIndex As Long
     lpstrFile As String
     nMaxFile As Long
     lpstrFileTitle As String
     nMaxFileTitle As Long
     lpstrInitialDir As String
     lpstrTitle As String
     flags As Long
     nFileOffset As Integer
     nFileExtension As Integer
     lpstrDefExt As String
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
End Type

Answer 6

to 李洪根，我知道使用&h200标志可以多选，但是那个多选界面太原始，我想找一个像现在windows中的那样，左边有“桌面”、“我的电脑”等按钮这种流行的打开界面。
另外，虽然可以自己做，但是感觉不合群，呵呵。

Answer 7

各位阿，我就是不想要那种界面的多选框阿！感觉在Windows3.1下似的，不好看。

Answer 8

ofn.flags = &H80000 + &H200   '注意这里

Answer 9

to 龙卷风，我第一个帖子就说了可以通过手动添加&h200实现。而且你的代码虽然可以多选，但只能返回路径不能返回选择的多个文件名。不信你试试！

Answer 10

我说了，虽然能完成，但是那个多选界面像windows3.1下的，很古老。
我想要一个像现在这样的打开多选界面，左边有“桌面”、“我的电脑”等按钮。

Answer 11

看看
Private Sub FileOpen_Click()
    Dim ofn As OPENFILENAME
    Dim rtn As String    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = Me.hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "所有文件"
    ofn.lpstrFile = Space(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = App.path
    ofn.lpstrTitle = "打开文件"
    ofn.flags = &H80000 + &H200
    rtn = GetOpenFileName(ofn)    If rtn >= 1 Then
        Dim s As String
    s = ofn.lpstrFile
    Dim arr
    arr = Split(s, Chr(0)) '不同的系统分割符可能不同，我这是在2000下
    Dim path As String
    Dim file1 As String
    Dim i As Long
    i = InStrRev(arr(0), "\")
    List1.Clear
    If i > 0 Then
        path = Left(arr(0), i - 1)
        If UBound(arr) >= 1 Then
            For i = 1 To UBound(arr)
               If arr(i) = "" Then Exit Sub
                List1.AddItem path + "\" + arr(i)
            Next
        Else
            List1.AddItem s
        End If
    End If
    End If
End Sub模块
Option ExplicitDeclare Function GetOpenFileName Lib "comdlg32.dll" Alias _
        "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Type OPENFILENAME
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     lpstrFilter As String
     lpstrCustomFilter As String
     nMaxCustFilter As Long
     nFilterIndex As Long
     lpstrFile As String
     nMaxFile As Long
     lpstrFileTitle As String
     nMaxFileTitle As Long
     lpstrInitialDir As String
     lpstrTitle As String
     flags As Long
     nFileOffset As Integer
     nFileExtension As Integer
     lpstrDefExt As String
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
End Type

Answer 12

Private Sub FileOpen_Click()
    Dim ofn As OPENFILENAME
    Dim rtn As String    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = Me.hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "所有文件"
    ofn.lpstrFile = Space(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = App.path
    ofn.lpstrTitle = "打开文件"
    ofn.flags = &H80000 + &H200
    rtn = GetOpenFileName(ofn)    If rtn >= 1 Then
        Dim s As String
        s = Trim(ofn.lpstrFile)
        Dim arr
        Dim i As Long
        s = Left(s, Len(s) - 2) '除去结尾符号
        arr = Split(s, Chr(0)) '不同的系统分割符可能不同，我这是在2000下
    
    Dim path As String
    Dim file1 As String
    
    i = InStrRev(arr(0), "\")
    List1.Clear
    If i > 0 Then
        path = Left(arr(0), i - 1)
        If UBound(arr) >= 1 Then
            For i = 1 To UBound(arr)
               If arr(1) = "" Then
                    List1.AddItem ofn.lpstrFile
                    Exit Sub
               End If
               List1.AddItem path + "\" + arr(i)
            Next
        Else
            List1.AddItem s
        End If
    End If
    End If
End Sub

Answer 13

大虾，上面中尾部包含的这段代码是不是没有用阿？可否省略掉？
                   If arr(1) = "" Then
                        List1.AddItem ofn.lpstrFile
                        Exit Sub
                   End If