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 controls BSListView, BSImageList in BSAC controls

In VBA, do with step by step:

Step 1: Create Userform

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

Step 2: Click to userform, see window "Toolbox", right click on tab "Controls" -> "Import Page", select file "ImportToToolbox.pag" (Download)

(Do Step 2 only if you do not see BSAC controls on Toolbox window)

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

Step 4: Right click on userform -> View Code. Now you have widow to edit code. Copy below code:
'-------BEGIN COPY
'Author: Nguyen Duy Tuan - http://atoolspro.com OR http://bluesofts.net
'       Mail: duytuan@bluesofts.net - 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
        BSListView1.Items.Clear
        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
    BSListView1.Items.BeginUpdate
    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)
        Else
            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
    BSListView1.Items.EndUpdate
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"
    'ListView
    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 function GetFiles()
 
Step 5: Go to menu "Insert"->Module. Now you have widow to edit code. Copy below code:
'-------BEGIN COPY
Option Explicit 
'   RUN IF DECLARE:
'    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
#Else
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
    Else
        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
    'Compare
    If v1 = v2 Then
        SortByColumn = 0
    ElseIf v1 < v2 Then
        SortByColumn = -1
    Else
        SortByColumn = 1
    End If
    If Not UserForm1.BSListView1.SortIsAscending Then
        SortByColumn = -SortByColumn
    End If
    Set Item1 = Nothing
    Set Item2 = Nothing
End Function
'--------------------------------------------------------------
Sub ShowExlorer()
    UserForm1.Show
End Sub
'-------END COPY

Support online: https://www.facebook.com/groups/hocexcel/

'--------------------------------------------------------------