You are here Create File Explorer by BSListView and BSImageList - BSAC Controls

Create File Explorer by BSListView and BSImageList - BSAC Controls

Create File Explorer in VBA with BSListView controls, BSImageList in BSAC controls




In VBA, do it step by step:

Step 1: Create a Userform

Make sure that you have installed Add-in A-Tools (version or later) or BSAC.ocx activex controls (version or later) before performing Step 2

Step 2: Click on the Userform, view the "Toolbox" window, right click on the "Controls" tab => "Import Page", select the "ImportToToolbox.pag" file (Download)

(Only do Step 2 if you do not see the BSAC controls on the Toolbox window)

Step 3: Drag the controls to the Userform: BSComboBox (cbView), BSListView (BSListView1), BSButton (cmdSelectFolder), BSEdit(edtPath), BSImageList (iml16), BSImageList (iml32)

Step 4: Right click on the Userform -> View the Code. Now you have the widow to edit the code. Copy the code below:
'-------BEGIN COPY
'Author: Nguyen Duy Tuan - OR
'       Mail: - Tel: (84) 904210337
Option Explicit
Dim hwnd
Private Sub BSListView1_OnItemDblClick(ByVal Item As BSAC.BSListItem)
    ShellExecute hwnd, "OPEN", edtPath.Text & "\" & Item.Text
End Sub
Private Sub cbView_OnSelect()
    BSListView1.View = cbView.ItemIndex
End Sub
Private Sub cmdSelectFolder_OnClick()
    Dim sPath As String, Params As TBSBrowseForFolderParams
    Params.NewFolderButton = True
    Params.Title = "Please select folder:"
    'If BrowseForFolder(sPath, "Please select folder:") Then
    If BrowseForFolderEx(Params) Then
        sPath = Params.Result
        edtPath.Text = sPath
        'Add folder and files to BSListView
        GetAllFiles sPath, True 'Get Folder
        GetAllFiles sPath, False 'Get Files
    End If
End Sub
Private Sub GetAllFiles(sPath As String, ByVal GetFolder As Boolean)
    Dim Files, bf As New BSFunctions
    Dim cl As BSListColumn, li As BSListItem, Idx&, Ext$
    Dim I&, J&, s$
    Dim hIcon, hsmIcon
    ' Type of Files is array 2D= (1..m, 1...n)
    Files = GetFiles(Path:=sPath, Folder:=GetFolder, SubFolder:=False)
    'Add column header
    If BSListView1.Columns.Count = 0 Then 'Create columns for the first time
        For J = LBound(Files, 2) To UBound(Files, 2)
            If J 2 Then 'ignore index 2
                BSListView1.Columns.Add Files(LBound(Files, 1), J)
            End If
        Next J
        BSListView1.AutoColumns 'resize columns
    End If
    'Add items
    For I = LBound(Files, 1) + 1 To UBound(Files, 1) 'Get rows
        Ext = Files(I, 3) 'It is key to find image
        If GetFolder Then
            Ext = "folder"
        ElseIf Ext = ".ico" Then
            Idx = iml32.ListImages.AddIcon(sPath & "\" & Files(I, 1)) 'Create and Add icon to Imagelist size 32
            Idx = iml16.ListImages.AddIcon(sPath & "\" & Files(I, 1)) 'Create and Add icon to Imagelist size 16
        ElseIf Ext ".exe" And Ext ".ico" Then
            Idx = iml16.ListImages.IndexOf(Ext)
            Idx = -1 'let find icon
        End If
        If Idx = -1 Then 'not exists then add new icon for file type
            If GetAssociatedIcon(sPath & "\" & Files(I, 1), hIcon, hsmIcon) > 0 Then
                Idx = iml32.ListImages.AddIcon(hIcon, Ext) 'Add icon to Imagelist size 32
                iml16.ListImages.AddIcon hsmIcon, Ext 'Add icon to Imagelist size 16
            End If
        End If
        Set li = BSListView1.Items.Add(Files(I, 1), Idx)
        For J = 3 To UBound(Files, 2) 'Get columns
            li.SubItems.Add Files(I, J)
        Next J
    Next I
End Sub
Private Sub UserForm_Initialize()
    Dim hIcon, hIcon2
    hwnd = GetHwnd(Me)
    'Set resize userform, min, max button
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or _
                                    WS_SIZEBOX Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    iml16.PicWidth = 16
    iml16.PicHeight = 16
    iml32.PicWidth = 48
    iml32.PicHeight = 48
    hIcon = ExtractIcon(0, GetSysDir & "\shell32.dll", 3) 'Icon Folder
    hIcon2 = ExtractIcon(0, GetSysDir & "\shell32.dll", 3) 'Icon Folder
    iml16.ListImages.AddIcon hIcon, "folder"
    iml32.ListImages.AddIcon hIcon2, "folder"
    BSListView1.View = vsReport
    BSListView1.hSmallImageList = iml16.hImageList
    BSListView1.hImageList = iml32.hImageList
    BSListView1.RowSelect = True
    BSListView1.MultiSelect = True
    BSListView1.AllowCustomSort = True
    BSListView1.lpfnCustomSort = GetFuncPtr(AddressOf SortByColumn)
    'Add combobox View
    cbView.Items.Add "vsIcon"
    cbView.Items.Add "vsSmallIcon "
    cbView.Items.Add "vsList"
    cbView.Items.Add "vsReport"
    cbView.ItemIndex = 3 'vsReport
End Sub
Private Sub UserForm_Resize()
    If Width - BSListView1.Left > 0 Then
        BSListView1.Width = Width - BSListView1.Left - 17
    End If
    If Height - BSListView1.Top > 0 Then
        BSListView1.Height = Height - BSListView1.Top - 33
    End If
    'Caption = Width - BSListView1.Left - 8 & " : " & BSListView1.nWidth
End Sub
'-------END COPY
(*) Go to menu Tools->References
Select/check "AddinATools.dll" to use GetFiles() function
Step 5: Go to menu "Insert"->Module. Now you have the widow to edit the code. Copy the code below:
'-------BEGIN COPY
Option Explicit 
'    BSListView1.AllowCustomSort = True
'    BSListView1.lpfnCustomSort = GetFuncPtr(AddressOf SortByColumn)
'   SortByColumn run when click on column to sort
#If VBA7 Then
Function SortByColumn(ByVal lParam1 As LongPtr, ByVal lParam2 As LongPtr, ByVal Col As Long) As Long
Function SortByColumn(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal Col As Long) As Long
#End If
    Dim Item1 As BSListItem, Item2 As BSListItem
    Dim v1, v2
    Set Item1 = UserForm1.BSListView1.Items.GetItemFromLPARAM(lParam1)
    Set Item2 = UserForm1.BSListView1.Items.GetItemFromLPARAM(lParam2)
    'Get data from BSListView
    If Col = 0 Then
        v1 = Item1.Text
        v2 = Item2.Text
        v1 = Item1.SubItems(Col - 1)
        v2 = Item2.SubItems(Col - 1)
    End If
    'Convert data
    Select Case Col
        Case 2, 6:
            v1 = CDbl(v1)
            v2 = CDbl(v2)
        Case 3, 4, 5:
            v1 = CDate(v1)
            v2 = CDate(v2)
    End Select
    If v1 = v2 Then
        SortByColumn = 0
    ElseIf v1 < v2 Then
        SortByColumn = -1
        SortByColumn = 1
    End If
    If Not UserForm1.BSListView1.SortIsAscending Then
        SortByColumn = -SortByColumn
    End If
    Set Item1 = Nothing
    Set Item2 = Nothing
End Function
Sub ShowExlorer()
End Sub
'-------END COPY

Support online:

Download source code