excel tool: List objects / file and folders

Module_Common_SubFun.bas

------------------------------------------

Attribute VB_Name = "Module_Common_SubFun"
Option Explicit
Option Base 1

Public Function f_to_continue()
    Dim li_choice As Integer

    If f_if_sheet_exists(gs_report_name) Then
        li_choice = MsgBox(prompt:="The sheet " & gs_report_name & " already exists, " & _
                                   "it will be deleted and re-constructed, it's advisable " & _
                                   "to backup it first!" & Chr(13) & _
                                    Chr(13) & _
                           " Are you sure to continue?" _
                           , Buttons:=vbOKCancel + vbCritical + vbDefaultButton2 _
                           , Title:="Attention!")
        
        If li_choice = vbCancel Then
            f_to_continue = False
        Else
            f_to_continue = True
        End If
    Else
        f_to_continue = True
    End If
End Function

Public Function f_all_files_exist()
    Dim li_i As Integer
    Dim ls_current_path As String
    Dim ls_csv_file As String
    Dim ls_tmp_file As String
    
    ls_current_path = ThisWorkbook.Path
    
    For li_i = 0 To gdict_csv.Count - 1
        ls_csv_file = ls_current_path & "\" & gdict_csv.Items(li_i) & ".csv"

        ls_tmp_file = Dir(ls_csv_file)
        If ls_tmp_file = "" Then
            f_all_files_exist = False
            MsgBox ("File " & ls_csv_file & " doesn't exist, please make sure it be there first.")
            Exit Function
        End If
    Next
    
    f_all_files_exist = True
End Function

Public Function f_import_all_files()
    Dim li_i As Integer
    Dim ls_current_path As String
    Dim ls_csv_file As String
    Dim ls_tmp_file As String
    
    On Error GoTo 0
    
    If Not f_if_sheet_exists("to_be_delete") Then ThisWorkbook.Worksheets.Add.Name = "to_be_delete"
    
    Dim lo_each_sheet As Worksheet
    For Each lo_each_sheet In ThisWorkbook.Worksheets
        If lo_each_sheet.Name = gs_report_name Then
            lo_each_sheet.Delete
        ElseIf Not gdict_report_name.Exists(lo_each_sheet.Name) And lo_each_sheet.Name <> "to_be_delete" Then
            lo_each_sheet.Delete
        End If
    Next
    
    ThisWorkbook.Worksheets.Add.Name = gs_report_name
    ThisWorkbook.Worksheets("to_be_delete").Delete
    
    ls_current_path = ThisWorkbook.Path
    
    For li_i = 0 To gdict_csv.Count - 1
        ls_csv_file = ls_current_path & "\" & gdict_csv.Items(li_i) & ".csv"

        Call sub_import_each_csv(ls_csv_file, gdict_csv_col_type(gdict_csv.Keys(li_i)), gdict_csv_charset(gdict_csv.Keys(li_i)))
    Next
    
    ThisWorkbook.Worksheets(gs_report_name).Activate
    
    f_import_all_files = True
End Function

Public Function f_check_if_no_records()
    If IsEmpty(garr_need_chk_no_data) Then
        f_check_if_no_records = True
        Exit Function
    End If
    
    Dim li_each As Integer
    Dim li_max As Integer
    
    Dim larr_data
    
    li_max = UBound(garr_need_chk_no_data)
    
    For li_each = 1 To li_max
        larr_data = Worksheets(gdict_csv(garr_need_chk_no_data(li_each))).UsedRange
        
        If IsEmpty(larr_data) Then GoTo error_no_data
        
        If UBound(larr_data) = 1 Then GoTo error_no_data
    Next
    
    f_check_if_no_records = True
    Exit Function
        
error_no_data:
    MsgBox prompt:="CSV file " & gdict_csv(garr_need_chk_no_data(li_each)) & ".csv has no data. " & Chr(13) & _
                    "Please correctly prepare it before running this macro." _
       , Buttons:=vbCritical + vbOKOnly _
       , Title:="No data found!"
       
    f_check_if_no_records = False
    Exit Function
End Function

Public Sub sub_import_each_csv(ByVal as_csv_file_name As String _
                             , ByVal a_col_data_type As Variant _
                             , ByVal a_csv_charset)

    On Error GoTo 0
    
    Dim lo_new_sheet As Worksheet
    Dim ls_file_base_name As String
    
    'open csv file
    Dim fso As FileSystemObject
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(as_csv_file_name) Then
        Set fso = Nothing
        MsgBox ("File " & as_csv_file_name & " not exists!")
        Exit Sub
    End If
    
    ls_file_base_name = fso.GetBaseName(as_csv_file_name)
    
    Set fso = Nothing
    
    Set lo_new_sheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    lo_new_sheet.Name = ls_file_base_name
    
    'ThisWorkbook.Worksheets.Add.Name = ls_file_base_name
    lo_new_sheet.Cells.NumberFormat = "@"
    
    'On Error Resume Next
    
    If IsEmpty(a_col_data_type) Then a_col_data_type = Array(1)
    
    With lo_new_sheet.QueryTables.Add(Connection:="TEXT;" & as_csv_file_name, Destination:=lo_new_sheet.Range("$A$1"))
        .Name = ls_file_base_name
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        '.TextFilePlatform = 437
        '.TextFilePlatform = 65001
        .TextFilePlatform = a_csv_charset
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = a_col_data_type
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    'lo_new_sheet.Visible = xlSheetHidden
    'lo_new_sheet.Visible = xlSheetVeryHidden
End Sub
 
Public Function f_pre_check(ByVal as_report_type As String)
    
    
    If Not f_if_sheet_exists(gs_report_name) Then
        MsgBox prompt:="There's no report of " & gs_report_name & "," & Chr(13) & _
                       "Please generate it first!" _
               , Buttons:=vbCritical + vbOK + vbDefaultButton1 _
               , Title:="Please extract the report first!"
        f_pre_check = False
        Exit Function
    End If
    
    If ThisWorkbook.Worksheets(gs_report_name).Range("A1").CurrentRegion.Rows.Count <= 1 Then
        MsgBox prompt:="No data was found in report " & as_report_type & _
                       ", please extract the report " & as_report_type & " first!", _
           Buttons:=vbInformation + vbOKCancel + vbDefaultButton1, _
           Title:="No data!"
        f_pre_check = False
        Exit Function
    End If
    
    f_pre_check = True
End Function

Public Function f_get_file_save_path(ByVal as_report_type As String, _
                                     ByRef as_output_file As String)
    Dim fso As New FileSystemObject
    Dim ls_output_file As String
    
    'Dim ls_drive As String
    Dim ls_curr_path As String
    
    ls_curr_path = gs_saved_path
    If ls_curr_path = "" Then ls_curr_path = Trim(ThisWorkbook.Path)
    
    'ls_drive = fso.GetDriveName(ls_curr_path)
    'ChDrive ls_drive
    'ChDir ls_curr_path

    ls_output_file = ls_curr_path & "\" & "HKMA_DPS_RPT_" & as_report_type & ".txt"
    
'    as_output_file = ls_output_file              'richard test
'    f_get_file_save_path = True              'richard test
'    Exit Function                       'richard test
    
    ls_output_file = Application.GetSaveAsFilename(ls_output_file, _
                                                 "Text files (*.txt), *.txt", 1, "Save as text file")
   
    If Trim(ls_output_file) = "False" Then
        Set fso = Nothing
        MsgBox prompt:="Process was aborted.", Buttons:=vbExclamation, Title:="Aborted!"
        f_get_file_save_path = False
        Exit Function
    End If
                
    If Trim(ls_output_file) = "" Then
        Set fso = Nothing
        f_get_file_save_path = False
        Exit Function
    End If
    
    Dim li_choice As Integer
    
    If fso.FileExists(ls_output_file) Then
        Do While True
            li_choice = MsgBox(prompt:="File already exists! " & Chr(13) & _
                                       "Press " & Chr(13) & _
                                       "      Yes to overwrite it, " & Chr(13) & _
                                       "      No to choose another name,  " & Chr(13) & _
                                       "      Cancel to abort." _
                            , Buttons:=vbCritical + vbYesNoCancel + vbDefaultButton1 _
                            , Title:="File already exists!" _
                            )
        
            If li_choice = vbNo Then
                ls_output_file = Application.GetSaveAsFilename(ls_output_file, _
                                                            "Text files (*.txt), *.txt", 1, "Save as text file")
                If Trim(ls_output_file) = "" Or Trim(ls_output_file) = "False" Then
                    Set fso = Nothing
                    MsgBox prompt:="Process was aborted.", Buttons:=vbExclamation, Title:="Aborted!"
                    f_get_file_save_path = False
                    Exit Function
                End If
            End If
        
            If li_choice = vbCancel Then
                Set fso = Nothing
                MsgBox prompt:="Process was aborted.", Buttons:=vbExclamation, Title:="Aborted!"
                f_get_file_save_path = False
                Exit Function
            End If
            
            If li_choice = vbYes Then
                Exit Do
            End If
        Loop
    End If
    
    gs_saved_path = fso.GetParentFolderName(ls_output_file)
    Set fso = Nothing
    
    as_output_file = ls_output_file
    f_get_file_save_path = True
End Function
 


Public Sub sub_format_column_to_text(ByVal al_row_from As Long, ByVal al_row_to As Long)
    Dim li_i As Integer
    Dim ls_range As String
    Dim lo_rng As Range
    Dim li_each_time As Integer
    Dim li_col_no As Integer
    
    'format base column to text format, especially force format date to text
    For li_i = 1 To UBound(gar_txt_fmt_col)
        If li_i = 1 Then
            ls_range = gar_txt_fmt_col(li_i) & al_row_from & ":" & gar_txt_fmt_col(li_i) & al_row_to
        Else
            ls_range = ls_range & "," & gar_txt_fmt_col(li_i) & al_row_from & ":" & gar_txt_fmt_col(li_i) & al_row_to
        End If
    Next

    If UBound(gar_txt_fmt_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.NumberFormat = "@"
    End If

    ' set the date for repeated columns
    For li_each_time = 1 To gi_header_repeat_cnt
        'cis
        For li_i = 1 To UBound(gar_rptd_txt_fmt_col)
            li_col_no = dict_col_indx(gar_rptd_txt_fmt_col(li_i)) + gi_rpt_col_num * (li_each_time - 1)

            If li_i = 1 Then
                ls_range = Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(al_row_from, li_col_no), Sheets(gs_report_name).Cells(al_row_to, li_col_no)).Address
            Else
                ls_range = ls_range & "," & Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(al_row_from, li_col_no), Sheets(gs_report_name).Cells(al_row_to, li_col_no)).Address
            End If
        Next

        If UBound(gar_rptd_txt_fmt_col) > 0 Then
            Set lo_rng = Sheets(gs_report_name).Range(ls_range)
            lo_rng.NumberFormat = "@"
        End If
    Next
    
    Set lo_rng = Nothing
End Sub


ThisWorkbook.cls

-----------------------------------

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisWorkbook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Const gs_toolbar_task_deploy As String = "toolbar_list_all_objects"

Private Sub Workbook_Activate()
    On Error Resume Next
    
    Application.CommandBars(gs_toolbar_task_deploy).Visible = True
End Sub

Private Sub Workbook_Deactivate()
    On Error Resume Next
    
    Application.CommandBars(gs_toolbar_task_deploy).Visible = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    
    Call sub_RemoveToolBar(gs_toolbar_task_deploy)
  '  Call sub_remove_all_bars
End Sub

Private Sub Workbook_Open()
    Dim ls_tool_bar As String
        
    ls_tool_bar = gs_toolbar_task_deploy
    Call sub_RemoveToolBar(ls_tool_bar)
    'Call sub_remove_all_bars
    
    'gs_toolbar_task_deploy
    '============================================================================================
    Call sub_add_new_bar(ls_tool_bar)
    Call sub_add_new_button(as_bar_name:=ls_tool_bar, _
                            as_btn_caption:="List Files", _
                            as_on_action:="sub_main_list_all_object", _
                            ai_face_id:=500, _
                            as_tip_text:="List all objects")
    Call sub_add_new_button(as_bar_name:=ls_tool_bar, _
                            as_btn_caption:="Open Selected", _
                            as_on_action:="sub_open_selected", _
                            ai_face_id:=509, _
                            as_tip_text:="Open Selected")

'    Call sub_add_new_button(as_bar_name:=gs_toolbar_task_deploy, _
'                            as_btn_caption:="", _
'                            as_on_action:="'sub_RemoveToolBar ""toolbar_extract_report"" '", ai_face_id:=722, _
'                            as_tip_text:="Exit this toolbar")
    '============================================================================================
   
End Sub



Module_Businesses.bas

------------------------------------

Attribute VB_Name = "Module_Businesses"
Option Explicit
Option Base 1
'Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long

'Public Type BROWSEINFO
'    hOwner As Long
'    pidlRoot As Long
'    pszDisplayName As String
'    lpszTitle As String
'    ulFlags As Long
'    lpfn As Long
'    lParam As Long
'    iImage As Long
'End Type

'============= config text /label ===============================
Const SOURCE_PATH = "Path"
Const SHOW_EMPTY_FOLDER = "Show Empty Folder or Not"
Const USE_FILTER = "Use File/Folder Filter"
Const TARGET_FOLDERS = "TARGET FOLDERS"
Const TARGET_FILES = "TARGET FILES"
Const EXCLUDED_FOLDERS = "EXCLUDED FOLDERS"
Const EXCLUDED_FILES = "EXCLUDED FILES"
'================================================================

'Public gs_source_path As String
Public gb_show_empty_folder As Boolean
Public gb_use_general_filter As Boolean

Public gb_use_filter_target_folder As Boolean
Public gb_use_filter_target_file As Boolean
Public gb_use_filter_excld_folder As Boolean
Public gb_use_filter_excld_file As Boolean

Public gdct_filter_target_folders As Dictionary
Public gdct_filter_target_files As Dictionary
Public garr_filter_target_folder_regexp() 'As String
Public garr_filter_target_file_regexp() 'As String
Public gdct_filter_exclude_folders As Dictionary
Public gdct_filter_exclude_files As Dictionary
Public garr_filter_excld_folder_regexp() 'As String
Public garr_filter_excld_file_regexp() 'As String

'Public garr_empty_folder_list()
Public garr_target_folder_list()
Public g_dct_empty_folder_list As Dictionary
'Public gb_target_folder_check_need As Boolean

Public gl_max_hirachy As Long
Const FULL_PATH_COLUMN = 15
Public gb_print_full_path_folder As Boolean
Public gb_print_full_path_file As Boolean

Public Sub sub_main_list_all_object()
    gb_print_full_path_folder = 0
    gb_print_full_path_file = 1
    
    Dim lo_file_dialog As FileDialog
    Dim ls_source_folder As String
    
    Dim lo_range As Range
    
    Set lo_range = ThisWorkbook.Worksheets("Config").Cells.Find(What:=SOURCE_PATH, After:=Range("A1"), LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)

    'Application.DefaultFilePath = Trim(lo_range.Offset(0, 1).Text)

    Set lo_file_dialog = Application.FileDialog(msoFileDialogFolderPicker)
    lo_file_dialog.Title = "Please choose a folder"
    
    If Not lo_range Is Nothing Then
        lo_file_dialog.InitialFileName = Trim(lo_range.Offset(0, 1))
    End If
    
    Dim li_test As Integer
    
    li_test = lo_file_dialog.Show   '0: cancel, 1: OK
    
    If li_test <> -1 Then Exit Sub
    
    ls_source_folder = lo_file_dialog.SelectedItems(1)
    
    If Not lo_range Is Nothing Then
        lo_range.Offset(0, 1) = ls_source_folder
    End If
    
    Dim larr_test()
    larr_test = f_is_file_or_folder(ls_source_folder)
    
    If larr_test(1) = "EXISTING_FOLDER" Then
    Else
        MsgBox "The path """ & ls_source_folder & """ got error."
        Exit Sub
    End If
    
    'ThisWorkbook.Worksheets("Output").Cells.Delete Shift:=xlUp
    
    If Not f_if_sheet_exists("Output") Then ThisWorkbook.Worksheets.Add.Name = "Output"
    
    ThisWorkbook.Worksheets("Output").Cells.Clear
    
    Call sub_read_config
    
    gl_max_hirachy = 0
    Call sub_get_target_folder_list(ls_source_folder, 0)
    
    Set g_dct_empty_folder_list = New Dictionary
    Call sub_get_empty_folder_list(ls_source_folder, False)
        
    ThisWorkbook.Worksheets("Output").Cells(2, 2) = ls_source_folder
   
    Call sub_list_objects_of_folder(ls_source_folder, 3, 2)
    
    'Call sub_list_full_name
    
    Call sub_format_sheets
    Range("A1").Select
    
    If gb_print_full_path_folder Or gb_print_full_path_file Then
        If gl_max_hirachy >= FULL_PATH_COLUMN Then
            MsgBox "The column O overwrites the result (because the max hirachy is & " & gl_max_hirachy & _
                   " ), please change the macro accordingly.(change FULL_PATH_COLUMN to other value, say 20)"
        End If
    End If
End Sub

Sub sub_read_config()
    Dim larr_config
    
    Dim ll_max_row As Long
    
    ll_max_row = f_get_valid_data_max_row(ThisWorkbook.Worksheets("Config"))
    
    larr_config = ThisWorkbook.Worksheets("Config").Range("B1:C" & ll_max_row)
    
    'Dim ls_config_value As String
'    If f_read_block(larr_config, SOURCE_PATH, "SOLE", Null, Null, ls_config_value) < 0 Then Exit Sub
    
    gb_show_empty_folder = False
    gb_use_general_filter = False
    
    gb_use_filter_target_folder = False
    gb_use_filter_target_file = False
    gb_use_filter_excld_folder = False
    gb_use_filter_excld_file = False

    If f_read_block(larr_config, SHOW_EMPTY_FOLDER, "SOLE", Null, Null, gb_show_empty_folder) < 0 Then Exit Sub
    If f_read_block(larr_config, USE_FILTER, "SOLE", Null, Null, gb_use_general_filter) < 0 Then Exit Sub
    
    If gb_use_general_filter Then
        If f_read_block(larr_config, TARGET_FOLDERS, "SOLE", Null, Null, gb_use_filter_target_folder) < 0 Then Exit Sub
        If f_read_block(larr_config, TARGET_FILES, "SOLE", Null, Null, gb_use_filter_target_file) < 0 Then Exit Sub
        If f_read_block(larr_config, EXCLUDED_FOLDERS, "SOLE", Null, Null, gb_use_filter_excld_folder) < 0 Then Exit Sub
        If f_read_block(larr_config, EXCLUDED_FILES, "SOLE", Null, Null, gb_use_filter_excld_file) < 0 Then Exit Sub
    End If
        
    If gb_use_filter_target_folder Then
        Set gdct_filter_target_folders = New Dictionary
        If f_read_block(larr_config, TARGET_FOLDERS, "BLOCK", gdct_filter_target_folders, garr_filter_target_folder_regexp, Empty) < 0 Then Exit Sub
        
        If gdct_filter_target_folders.Count <= 0 And UBound(garr_filter_target_folder_regexp) <= 0 Then
            gb_use_filter_target_folder = False
        End If
    End If
        
    If gb_use_filter_target_file Then
        Set gdct_filter_target_files = New Dictionary
        If f_read_block(larr_config, TARGET_FILES, "BLOCK", gdct_filter_target_files, garr_filter_target_file_regexp, Empty) < 0 Then Exit Sub
    
        If gdct_filter_target_files.Count <= 0 And UBound(garr_filter_target_file_regexp) <= 0 Then
            gb_use_filter_target_file = False
        End If
    End If
    
    If gb_use_filter_excld_folder Then
        Set gdct_filter_exclude_folders = New Dictionary
        If f_read_block(larr_config, EXCLUDED_FOLDERS, "BLOCK", gdct_filter_exclude_folders, garr_filter_excld_folder_regexp, Empty) < 0 Then Exit Sub
    
        If gdct_filter_exclude_folders.Count <= 0 And UBound(garr_filter_excld_folder_regexp) <= 0 Then
            gb_use_filter_excld_folder = False
        End If
    End If
    
    If gb_use_filter_excld_file Then
        Set gdct_filter_exclude_files = New Dictionary
        If f_read_block(larr_config, EXCLUDED_FILES, "BLOCK", gdct_filter_exclude_files, garr_filter_excld_file_regexp, Empty) < 0 Then Exit Sub
    
        If gdct_filter_exclude_files.Count <= 0 And UBound(garr_filter_excld_file_regexp) <= 0 Then
            gb_use_filter_excld_file = False
        End If
    End If
'    Else
'        garr_filter_target_folder_regexp = Array()
'        garr_filter_target_file_regexp = Array()
'        garr_filter_excld_folder_regexp = Array()
'        garr_filter_excld_file_regexp = Array()
'    End If
End Sub

Function f_read_block(ByVal larr_config _
                 , ByVal as_config_label As String _
                 , ByVal as_block_or_sole_item As String _
                 , ByRef dct_filter _
                 , ByRef arr_filter_regexp _
                 , ByRef ab_config_value As Boolean) As Integer
    
    Dim ll_each_row As Long
    Dim ls_key As String

    Dim ll_row_found As Long
    Dim ll_block_end_row As Long
    Dim ll_max_row As Long
    
    Dim ls_config_value As String
    
    ll_row_found = 0
    ll_block_end_row = 0
    
    ll_max_row = UBound(larr_config)
    
    If as_block_or_sole_item = "SOLE" Then
        ls_config_value = ""
        ab_config_value = True
        
        For ll_each_row = 1 To ll_max_row
            If Trim(larr_config(ll_each_row, 1)) = as_config_label Then
                ll_row_found = ll_each_row
                Exit For
            End If
        Next
        
        If ll_row_found > 0 Then
            ls_config_value = larr_config(ll_row_found, 2)
            If UCase(ls_config_value) = "Y" Or UCase(ls_config_value) = "YES" Then
                ab_config_value = True
            Else
                ab_config_value = False
            End If
    
            f_read_block = 0
            Exit Function
        Else
            MsgBox "Unable to read the config of " & as_config_label
            f_read_block = -1
            Exit Function
        End If
    End If
    
    If as_block_or_sole_item = "BLOCK" Then
        ll_row_found = 0
        ll_block_end_row = 0
    
        Set dct_filter = New Dictionary
               
        For ll_each_row = 1 To ll_max_row
            If ll_row_found <= 0 Then
                If Trim(larr_config(ll_each_row, 1)) = as_config_label Then
                    ll_row_found = ll_each_row
                End If
            End If
            
            If ll_row_found > 0 Then
                If ll_each_row > ll_row_found Then
                    If Len(Trim(larr_config(ll_each_row, 1))) = 0 Or Trim(larr_config(ll_each_row, 1)) = as_config_label Then
                        ll_block_end_row = ll_each_row
                    Else
                        Exit For
                    End If
                End If
            End If
        Next
        
        Dim li_arr_cnt As Long
        
        li_arr_cnt = 0
        If ll_row_found > 0 And ll_block_end_row > 0 Then
            For ll_each_row = ll_row_found + 1 To ll_block_end_row
                ls_key = Trim(larr_config(ll_each_row, 2))
                
                If Len(ls_key) > 0 Then
                    If InStr(ls_key, "*") > 0 Then
                        li_arr_cnt = li_arr_cnt + 1
                        ReDim Preserve arr_filter_regexp(1 To li_arr_cnt)
                        
                        ls_key = Replace(ls_key, ".", "\.")
                        ls_key = Replace(ls_key, "*", ".*")
                        arr_filter_regexp(li_arr_cnt) = ls_key
                        
                    ElseIf Not dct_filter.Exists(ls_key) Then
                        dct_filter(ls_key) = 1
                    End If
                End If
            Next
        Else
            MsgBox "Unable to read the config of " & as_config_label
            f_read_block = -1
            Exit Function
        End If
        
        If li_arr_cnt = 0 Then
            arr_filter_regexp = Array()
        End If
    End If
End Function

Sub sub_get_target_folder_list(ByVal as_source_folder As String, ByRef al_arr_cnt As Long)
    'no need to filter any folder
    If Not gb_use_general_filter Then
        garr_target_folder_list = Array()
        Exit Sub
    End If
    
    'to match the list of target folder
    If Not gb_use_filter_target_folder Then
        garr_target_folder_list = Array()
        Exit Sub
    End If
    
    Dim lo_fso As New FileSystemObject
    Dim lo_source_folder As Folder
    
    Set lo_source_folder = lo_fso.GetFolder(as_source_folder)
    
'    If GetAttr(lo_source_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
'        Exit Sub
'    End If
    
    Dim lo_sub_folder As Folder
    
    'sub folders
    For Each lo_sub_folder In lo_source_folder.SubFolders
        If GetAttr(lo_sub_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
            GoTo next_for_folder
        End If
        
'        If lo_sub_folder.Name = "lib" Then
'            MsgBox lo_sub_folder.Name
'        End If
        
        If f_is_target_item(lo_sub_folder.Name, "FOLDER") Then
            'g_dct_fitted_folders(lo_sub_folder.Path) = 1
            al_arr_cnt = al_arr_cnt + 1
            ReDim Preserve garr_target_folder_list(1 To al_arr_cnt)
            garr_target_folder_list(al_arr_cnt) = lo_sub_folder.Path
        End If
        
        Call sub_get_target_folder_list(lo_sub_folder.Path, al_arr_cnt)
        
next_for_folder:
    Next
    
    Set lo_fso = Nothing
    Set lo_source_folder = Nothing
End Sub


Sub sub_list_objects_of_folder(ByVal as_source_folder As String _
                             , ByRef al_row As Long _
                             , ByVal al_col As Long)
    
    Dim lo_fso As New FileSystemObject
    Dim lo_source_folder As Folder
    
    Set lo_source_folder = lo_fso.GetFolder(as_source_folder)
    
'    If GetAttr(lo_source_folder) = &H1 Or GetAttr(lo_source_folder) = &H1 + &H10 Then
'        Exit Sub
'    End If
    
'    If GetAttr(lo_source_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
'        Exit Sub
'    End If
    
    Dim lo_sub_folder As Folder
    Dim lo_sub_file As File
    
    Dim lb_is_fitted_folder As Boolean
    Dim ll_each_item As Long
    
    al_col = al_col + 1
    
        
    'sub folders
    For Each lo_sub_folder In lo_source_folder.SubFolders
        If f_if_need_to_skip_this_folder(lo_sub_folder) Then
            GoTo next_for_folder
        End If
        
        If al_col > gl_max_hirachy Then
            gl_max_hirachy = al_col
        End If
        
        al_row = al_row + 1
        ThisWorkbook.Worksheets("Output").Cells(al_row, al_col) = lo_sub_folder.Name & "\"
        
        If gb_print_full_path_folder Then
            ThisWorkbook.Worksheets("Output").Cells(al_row, FULL_PATH_COLUMN) = lo_sub_folder.Path & "\"
        End If
        
        Call sub_list_objects_of_folder(lo_sub_folder.Path, al_row, al_col)
        
next_for_folder:
    Next
    
'    'if this folder itself need to skip, then its
'    If Not f_is_target_item(lo_source_folder.Name, "FOLDER") Then GoTo exit_sub
    
    'sub files
    For Each lo_sub_file In lo_source_folder.Files
        If Not f_if_need_to_skip_this_file(lo_sub_file) Then
            
            If al_col > gl_max_hirachy Then
                gl_max_hirachy = al_col
            End If
        
            al_row = al_row + 1
            ThisWorkbook.Worksheets("Output").Cells(al_row, al_col) = lo_sub_file.Name
            
            If gb_print_full_path_file Then
                ThisWorkbook.Worksheets("Output").Cells(al_row, FULL_PATH_COLUMN) = lo_sub_file.Path
            End If
        End If
    Next
    
'exit_sub:
    Set lo_fso = Nothing
    Set lo_source_folder = Nothing
End Sub

Function f_if_need_to_skip_this_folder(ByVal ao_folder As Folder) As Boolean
    'hidden folder, to skip
    If GetAttr(ao_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
        f_if_need_to_skip_this_folder = True
        Exit Function
    End If
    
    'skip empty folder
    If Not gb_show_empty_folder Then
        If g_dct_empty_folder_list.Exists(ao_folder.Path) Then
            f_if_need_to_skip_this_folder = True
            Exit Function
        End If
    End If
    
    'no need to filter any folder
    If Not gb_use_general_filter Then
        f_if_need_to_skip_this_folder = False
        Exit Function
    End If
    
    Dim ll_each_item As Long
    
    'to match the list of target folder
    If gb_use_filter_target_folder Then
        f_if_need_to_skip_this_folder = True
                
        For ll_each_item = 1 To UBound(garr_target_folder_list)
            If InStr(garr_target_folder_list(ll_each_item), ao_folder.Path) > 0 Then
                f_if_need_to_skip_this_folder = False
                Exit For
            End If
        Next
        
        Exit Function
    End If
    
    'to match the list of exclude folder
    If gb_use_filter_excld_folder Then
        If f_is_excluded_item(ao_folder.Name, "FOLDER") Then
            f_if_need_to_skip_this_folder = True
            Exit Function
        End If
    End If
    
    f_if_need_to_skip_this_folder = False
End Function

Function f_if_need_to_skip_this_file(ByVal ao_file As File) As Boolean
    'hidden file
    If GetAttr(ao_file) = vbHidden + vbNormal Then  '&H1 + &H10
        f_if_need_to_skip_this_file = True
        Exit Function
    End If
    
    'no need to filter any file
    If Not gb_use_general_filter Then
        f_if_need_to_skip_this_file = False
        Exit Function
    End If
    
    'to match with the list of target files
    If gb_use_filter_target_file Then
        If Not f_is_target_item(ao_file.Name, "FILE") Then
            f_if_need_to_skip_this_file = True
            Exit Function
        End If
    End If
        
    'to match with the list of excluded files
    If gb_use_filter_excld_file Then
        If f_is_excluded_item(ao_file.Name, "FILE") Then
            f_if_need_to_skip_this_file = True
            Exit Function
        End If
    End If
    
    f_if_need_to_skip_this_file = False
End Function

Public Function f_is_target_item(ByVal as_file_folder_name As String _
                                 , ByVal as_type As String)
        
    If Not gb_use_general_filter Then
        f_is_target_item = True
        Exit Function
    End If
    
    If as_type = "FOLDER" And Not gb_use_filter_target_folder Then
        f_is_target_item = True
        Exit Function
    End If
    
    If as_type = "FILE" And Not gb_use_filter_target_file Then
        f_is_target_item = True
        Exit Function
    End If
    
'    If as_type = "FOLDER" Then
'        If gdct_filter_target_folders.Count <= 0 And UBound(garr_filter_target_folder_regexp) <= 0 Then
'            f_is_target_item = True
'            Exit Function
'        End If
'    End If
'
'    If as_type = "FILE" Then
'        If gdct_filter_target_files.Count <= 0 And UBound(garr_filter_target_file_regexp) <= 0 Then
'            f_is_target_item = True
'            Exit Function
'        End If
'    End If
    
    Dim ll_each As Long
    Dim lo_RegExp As New RegExp
    
    lo_RegExp.Global = True
    lo_RegExp.IgnoreCase = True
    
    Dim mc As MatchCollection
    Dim m As Match
                               
    If as_type = "FOLDER" Then
        If gdct_filter_target_folders.Exists(as_file_folder_name) Then
            f_is_target_item = True
            Set lo_RegExp = Nothing
            Exit Function
        End If
        
        For ll_each = 1 To UBound(garr_filter_target_folder_regexp)
            lo_RegExp.Pattern = garr_filter_target_folder_regexp(ll_each)
            
            If lo_RegExp.test(as_file_folder_name) Then
                
                Set mc = lo_RegExp.Execute(as_file_folder_name)
                
                For Each m In mc
                    If m.Length = Len(as_file_folder_name) Then
                        f_is_target_item = True
                        Set lo_RegExp = Nothing
                        Exit Function
                    End If
                Next
            End If
        Next
    End If
    
    If as_type = "FILE" Then
        If gdct_filter_target_files.Exists(as_file_folder_name) Then
            f_is_target_item = True
            Set lo_RegExp = Nothing
            Exit Function
        End If
        
        For ll_each = 1 To UBound(garr_filter_target_file_regexp)
            lo_RegExp.Pattern = garr_filter_target_file_regexp(ll_each)
            
            If lo_RegExp.test(as_file_folder_name) Then
                
                Set mc = lo_RegExp.Execute(as_file_folder_name)
                
                For Each m In mc
                    If m.Length = Len(as_file_folder_name) Then
                        f_is_target_item = True
                        Set lo_RegExp = Nothing
                        Exit Function
                    End If
                Next
            End If
        Next
    End If

    Set lo_RegExp = Nothing
    f_is_target_item = False
End Function

Public Function f_is_excluded_item(ByVal as_file_folder_name As String _
                                 , ByVal as_type As String)

    If Not gb_use_general_filter Then
        f_is_excluded_item = False
        Exit Function
    End If
    
    If as_type = "FOLDER" And Not gb_use_filter_excld_folder Then
        f_is_excluded_item = False
        Exit Function
    End If
    
    If as_type = "FILE" And Not gb_use_filter_excld_file Then
        f_is_excluded_item = False
        Exit Function
    End If
        
    Dim ll_each As Long
    Dim lo_RegExp As New RegExp
    
    lo_RegExp.Global = True
    lo_RegExp.IgnoreCase = True
    
    Dim mc As MatchCollection
    Dim m As Match
                               
    If as_type = "FOLDER" Then
        If gdct_filter_exclude_folders.Exists(as_file_folder_name) Then
            f_is_excluded_item = True
            Set lo_RegExp = Nothing
            Exit Function
        End If
        
        For ll_each = 1 To UBound(garr_filter_excld_folder_regexp)
            lo_RegExp.Pattern = garr_filter_excld_folder_regexp(ll_each)
            
            If lo_RegExp.test(as_file_folder_name) Then
                
                Set mc = lo_RegExp.Execute(as_file_folder_name)
                
                For Each m In mc
                    If m.Length = Len(as_file_folder_name) Then
                        f_is_excluded_item = True
                        Set lo_RegExp = Nothing
                        Exit Function
                    End If
                Next
            End If
        Next
    End If
    
    If as_type = "FILE" Then
        If gdct_filter_exclude_files.Exists(as_file_folder_name) Then
            f_is_excluded_item = True
            Set lo_RegExp = Nothing
            Exit Function
        End If
        
        For ll_each = 1 To UBound(garr_filter_excld_file_regexp)
            lo_RegExp.Pattern = garr_filter_excld_file_regexp(ll_each)
            
            If lo_RegExp.test(as_file_folder_name) Then
                
                Set mc = lo_RegExp.Execute(as_file_folder_name)
                
                For Each m In mc
                    If m.Length = Len(as_file_folder_name) Then
                        f_is_excluded_item = True
                        Set lo_RegExp = Nothing
                        Exit Function
                    End If
                Next
            End If
        Next
    End If

    Set lo_RegExp = Nothing
    f_is_excluded_item = False
End Function

Public Sub sub_format_sheets()
    On Error Resume Next
    
    Sheets("Output").Move before:=ThisWorkbook.Sheets(1)
    Sheets("Config").Move before:=ThisWorkbook.Sheets(1)

    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    
    Sheets("Output").Activate
    
    On Error GoTo 0
End Sub


Public Sub sub_open_selected()
'    If InStr(ActiveSheet.Name, "Output") <= 0 Then
'        MsgBox "Please select the coreect sheet: Output"
'        Exit Sub
'    End If
    
    Dim ls_selected As String
    
    ls_selected = Trim(ActiveCell.Text)
    
    If Len(ls_selected) = 0 Then
        Exit Sub
    End If
    
    
    Dim larr_data
    
    Dim ll_max_row As Long
    Dim ll_max_col As Long
    
    ll_max_row = f_get_valid_data_max_row(ActiveSheet)
    ll_max_col = f_get_valid_data_max_col(ActiveSheet)
    
    larr_data = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ll_max_row, ll_max_col))
    
    Dim ll_start_row As Long
    Dim ll_start_col As Long
    
    ll_start_row = 2
    ll_start_col = 2
    
    Dim ll_curr_row As Long
    Dim ll_curr_col As Long
    
    ll_curr_row = ActiveCell.Row
    ll_curr_col = ActiveCell.Column
    
    Dim ll_each_row As Long
    Dim ls_full_path As String
    Dim ls_path As String
    
    Dim ll_each_col As Long
    
    
    For ll_each_col = ll_curr_col - 1 To ll_start_col Step -1
        For ll_each_row = ll_curr_row To ll_start_row Step -1
            ls_path = Trim(larr_data(ll_each_row, ll_each_col))
            
            If Len(ls_path) = 0 Then
            Else
                If Right(ls_path, 1) = "\" Then
                    ls_full_path = ls_path & ls_full_path
                Else
                    ls_full_path = ls_path & "\" & ls_full_path
                End If
                
                Exit For
            End If
        Next
    Next
    
    ls_full_path = ls_full_path & Trim(ActiveCell.Text)
        
    Dim larr()
    larr = f_is_file_or_folder(ls_full_path)
    
    If larr(1) <> "EXISTING_FOLDER" And larr(1) <> "EXISTING_FILE" Then
        MsgBox larr(1) & Chr(13) & larr(2)
        Exit Sub
    End If
    
    Call sub_OpenFile(ls_full_path)
End Sub


Sub sub_get_empty_folder_list(ByVal as_source_folder As String _
                            , ByRef ab_is_empty_folder As Boolean)
    If gb_show_empty_folder Then
        Exit Sub
    End If
    
'    , ByRef al_arr_cnt As Long _

    
    Dim lo_fso As New FileSystemObject
    Dim lo_source_folder As Folder
    
    Set lo_source_folder = lo_fso.GetFolder(as_source_folder)
    
'    If GetAttr(lo_source_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
'        Exit Sub
'    End If
    
    Dim lo_sub_folder As Folder
    Dim lo_sub_file As File
    
    'sub folders
    Dim lb_no_sub_folders As Boolean
    
    lb_no_sub_folders = True
    
    For Each lo_sub_folder In lo_source_folder.SubFolders
        If GetAttr(lo_sub_folder) = vbHidden + vbDirectory Then  '&H1 + &H10
            GoTo next_for_folder
        End If
                
        Call sub_get_empty_folder_list(lo_sub_folder.Path, ab_is_empty_folder)
        
        If Not ab_is_empty_folder Then
            lb_no_sub_folders = False
        End If
next_for_folder:
    Next
    
    'sub files
    Dim lb_no_files As Boolean
    
    lb_no_files = True
    
    For Each lo_sub_file In lo_source_folder.Files
        If GetAttr(lo_sub_file) = vbHidden + vbNormal Then  '&H1 + &H10
            GoTo next_for_file
        End If
        
        If gb_use_filter_target_file Then
            If f_is_target_item(lo_sub_file.Name, "FILE") Then
                lb_no_files = False
            End If
            
            GoTo next_for_file
        End If
        
        If Not f_is_excluded_item(lo_sub_file.Name, "FILE") Then
            lb_no_files = False
            GoTo next_for_file
        End If
next_for_file:
    Next
    
    If lb_no_sub_folders And lb_no_files Then
        If Not g_dct_empty_folder_list.Exists(lo_source_folder.Path) Then
            g_dct_empty_folder_list(lo_source_folder.Path) = 1
        End If
        
        ab_is_empty_folder = True
    Else
        ab_is_empty_folder = False
    End If
    
'    If al_non_empty_folder_cnt <= 0 Then
'        al_arr_cnt = al_arr_cnt + 1
'        ReDim Preserve garr_empty_folder_list(1 To al_arr_cnt)
'        garr_empty_folder_list(al_arr_cnt) = lo_source_folder.Path
'    End If
    
    Set lo_fso = Nothing
    Set lo_source_folder = Nothing
End Sub

'Sub sub_list_full_name()
'    Dim ll_max_col As Long
'
'    ll_max_col = Worksheets("Output").UsedRange.Column + Worksheets("Output").UsedRange.Columns.Count
'
'    ll_max_col = ll_max_col + 4
'
'
'End Sub

Module_Routines.bas

--------------------------------------

Attribute VB_Name = "Module_Routines"
Option Explicit
Option Base 1

'#If Win64 Then
'   Declare PtrSafe Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong
'#Else
'   Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long
'#End If
'#If VBA7 Then
'   Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal N As Long)
'#Else
'   Declare Sub MessageBeep Lib "User32" (ByVal N AS Long)
'#End If


'#If VBA7 Then
     Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
                             ByVal lpOperation As String, ByVal lpFile As String, _
                             ByVal lpParameters As String, ByVal lpDirectory As String, _
                             ByVal nShowCmd As Long) As Long
'#Else
'    Declare Function ShellExecute Lib "shell32.dll" _
'      Alias "ShellExecuteA" (ByVal hWnd As Long, _
'                             ByVal lpOperation As String, ByVal lpFile As String, _
'                             ByVal lpParameters As String, ByVal lpDirectory As String, _
'                             ByVal nShowCmd As Long) As Long
'#End If
 

Public Sub sub_init_col_indx_alpha(ByRef ao_dict As Dictionary)
    Dim ll_i As Integer
    Dim ll_j As Integer
    Dim ll_cnt As Integer
    
'    ao_dict.Add "A", 1
'    ao_dict.Add "B", 2
'    ao_dict.Add "C", 3
'    ...

    'A to Z
    For ll_i = 1 To 26
        ao_dict(Chr(64 + ll_i)) = ll_i
    Next
    
    'AA to AZ, BA to BZ, ...
    ll_cnt = 26
    For ll_i = 1 To 10  ' A to J
        For ll_j = 1 To 26
            ll_cnt = ll_cnt + 1
            ao_dict(Chr(64 + ll_i) & Chr(64 + ll_j)) = ll_cnt
        Next
    Next
End Sub

Public Function f_LeftByBytes(ByVal adoStream As ADODB.Stream _
                            , ByVal as_str_in As String _
                            , ByVal ai_pos As Integer) As String
    Dim li_position As Integer
    Dim ls_text
    Dim ls_spaces   As String
    
    If ai_pos < 101 Then
        ls_spaces = String(100, " ")
    Else
        ls_spaces = String(500, " ")
    End If

    li_position = 3 + ai_pos    'BOM occupy 3 bytes
    
    'before write, clear all
    adoStream.Type = adTypeText
    adoStream.Position = 0
    adoStream.SetEOS
    
    adoStream.WriteText as_str_in + ls_spaces
    
    adoStream.Position = li_position
    adoStream.SetEOS
    
    adoStream.Position = 0
    ls_text = adoStream.ReadText()
    
    're-read, to avoid the last 2-bytes charactor be disposed
    adoStream.Position = 0
    adoStream.SetEOS
    adoStream.WriteText ls_text + ls_spaces
    
    adoStream.Position = li_position
    adoStream.SetEOS
    
    adoStream.Position = 0
    ls_text = adoStream.ReadText()
    
    'clear all, for next use
    adoStream.Position = 0
    adoStream.SetEOS

    'adoStream.Close
    
    f_LeftByBytes = ls_text
End Function

Public Function f_LenByBytes(ByVal adoStream As ADODB.Stream _
                            , ByVal as_str_in As String) As String
    Dim ls_bytes
    
    adoStream.Position = 0
    adoStream.SetEOS
    
    adoStream.Type = adTypeText
    adoStream.WriteText as_str_in
    
    adoStream.Position = 0
    adoStream.Type = adTypeBinary

    ls_bytes = adoStream.Read
    
    adoStream.Position = 0
    adoStream.SetEOS
    
    f_LenByBytes = UBound(ls_bytes) + 1 - 3
End Function


Public Sub sub_LenByBytes()
    Dim adoStream As New ADODB.Stream
    adoStream.Charset = "utf-8"
    adoStream.Type = 2 'adTypeText
    adoStream.Open
    
    MsgBox f_LenByBytes(adoStream, ActiveCell.Text)
    
    adoStream.Close
    Set adoStream = Nothing
End Sub

Public Function f_date2string(ByVal ad_date) As String
    If IsDate(ad_date) Then
        f_date2string = Format(ad_date, "dd/mm/yyyy")
    Else
        f_date2string = Format(ad_date, "@")
    End If
    
    Exit Function
End Function

Public Function f_date_rm_slash(ByVal as_date) As String
    If UCase(TypeName(as_date)) = "DATE" Then
        f_date_rm_slash = Left(Format(as_date, "ddmmyyyy") & String(8, " "), 8)
    Else
        f_date_rm_slash = Left(Replace(as_date, "/", "") & String(8, " "), 8)
    End If
    
    Exit Function
End Function

Public Function f_get_valid_data_max_row(ByVal ao_activesheet As Worksheet) As Long
    Dim ll_excel_max_row As Long
    ll_excel_max_row = ao_activesheet.Cells.Rows.Count
    
    Dim ll_used_max_col As Long
    ll_used_max_col = ao_activesheet.UsedRange.Column + ao_activesheet.UsedRange.Columns.Count - 1
    
    Dim ll_each_col As Long
    Dim ll_max_row_saved As Long
    Dim ll_max_row_each_col As Long
    
    ll_max_row_saved = 0
    
    For ll_each_col = 1 To ll_used_max_col
        ll_max_row_each_col = ao_activesheet.Cells(ll_excel_max_row, ll_each_col).End(xlUp).Row
        
        If ll_max_row_each_col > ll_max_row_saved Then ll_max_row_saved = ll_max_row_each_col
    Next
    
    f_get_valid_data_max_row = ll_max_row_saved
End Function

Public Function f_get_valid_data_max_col(ByVal ao_activesheet As Worksheet) As Long
    Dim ll_excel_max_col As Long
    ll_excel_max_col = ao_activesheet.Cells.Columns.Count
    
    Dim ll_used_max_row As Long
    ll_used_max_row = ao_activesheet.UsedRange.Row + ao_activesheet.UsedRange.Rows.Count - 1
    
    Dim ll_each_row As Long
    Dim ll_max_col_saved As Long
    Dim ll_max_col_each_row As Long
    
    ll_max_col_saved = 0
    
    For ll_each_row = 1 To ll_used_max_row
        ll_max_col_each_row = ao_activesheet.Cells(ll_each_row, ll_excel_max_col).End(xlToLeft).Column
        
        If ll_max_col_each_row > ll_max_col_saved Then ll_max_col_saved = ll_max_col_each_row
    Next
    
    f_get_valid_data_max_col = ll_max_col_saved
End Function

Public Sub sub_protect_data(ByRef ao_worksheet As Worksheet)
    On Error GoTo 0
    
   'ao_worksheet.Unprotect
    ao_worksheet.Cells.Locked = False
    
    Dim lo_range As Range
    
    Set lo_range = ao_worksheet.Range(ao_worksheet.Cells(1, 1) _
                                    , ao_worksheet.Cells(f_get_valid_data_max_row(ao_worksheet), f_get_valid_data_max_col(ao_worksheet)) _
                                      )

    ao_worksheet.UsedRange.Locked = True
    ao_worksheet.UsedRange.FormulaHidden = False

    ao_worksheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

'    ao_worksheet.Protect _
'        DrawingObjects:=True _
'        , Contents:=True _
'        , Scenarios:=True _
'        , AllowFormattingCells:=True _
'        , AllowFormattingColumns:=True _
'        , AllowFormattingRows:=True _
'        , AllowInsertingColumns:=False _
'        , AllowInsertingRows:=False _
'        , AllowInsertingHyperlinks:=True _
'        , AllowSorting:=True _
'        , AllowFiltering:=True
End Sub

Public Sub sub_open_txt_file(ByVal as_file As String)
    Dim lo_wsh As New WshSHell
    Dim ls_default_app As String
    Dim ls_app_path As String
    Dim ls_shell_str As String
    
    ls_default_app = lo_wsh.RegRead("HKEY_CLASSES_ROOT\.txt\")
    ls_app_path = lo_wsh.RegRead("HKEY_CLASSES_ROOT\" & ls_default_app & "\shell\open\Command\")
    
    If Len(ls_app_path) <= 0 Then
'        MsgBox prompt:=ls_default_app & " not installed!", Buttons:=vbCritical + vbOKOnly, Title:="Error"
'        Exit Sub
        ls_app_path = "notepad.exe %1"
    End If
        
    Dim ls_command As String
    ls_command = Application.Substitute(ls_app_path, "%1", as_file)
    
    lo_wsh.exec ls_command
    
    Set lo_wsh = Nothing
End Sub

Public Function f_if_sheet_exists(ByVal as_sheet_name As String)
    Dim lo_each_sheet As Worksheet
    
    'For Each lo_each_sheet In ao_workbook.Worksheets
    For Each lo_each_sheet In ThisWorkbook.Worksheets
         If LCase(lo_each_sheet.Name) = LCase(as_sheet_name) Then
             f_if_sheet_exists = True
             Exit Function
         End If
    Next
    
    f_if_sheet_exists = False
End Function

Public Function f_get_prev_monthend(ByVal ad_base_date As Date) As Date
    Dim ld_curr_date     As Date
    Dim ld_curr_mth_1st  As Date
    
    ld_curr_date = ad_base_date
    
    ld_curr_mth_1st = DateSerial(Year(ld_curr_date), Month(ld_curr_date), 1)
    
    f_get_prev_monthend = DateAdd("d", -1, ld_curr_mth_1st)
End Function

Public Function f_get_next_monthend(ByVal ad_base_date As Date) As Date
    Dim ld_curr_date            As Date
    Dim ld_curr_month_1st       As Date
    Dim ld_curr_month_last      As Date
    Dim ld_next_month_1st       As Date
    Dim ld_next_month_last      As Date
    
    Dim ld_next_next_month_1st  As Date
        
    ld_curr_date = ad_base_date
    'ld_curr_date = Date
    
    ld_curr_month_1st = DateSerial(Year(ld_curr_date), Month(ld_curr_date), 1)
    ld_next_month_1st = DateAdd("m", 1, ld_curr_month_1st)
    ld_curr_month_last = DateAdd("d", -1, ld_next_month_1st)
    
    If DateDiff("d", ld_curr_date, ld_curr_month_last) > 0 Then
        f_get_next_monthend = ld_curr_month_last
        Exit Function
    Else
        ld_next_next_month_1st = DateAdd("m", 1, ld_next_month_1st)
        ld_next_month_last = DateAdd("d", -1, ld_next_next_month_1st)
    
        f_get_next_monthend = ld_next_month_last
        Exit Function
    End If
End Function

Public Function f_remv_non_alphanum(ByVal as_string As String) As String
    Dim lo_RegExp As New RegExp
    
    lo_RegExp.Global = True
    lo_RegExp.IgnoreCase = True
    
    lo_RegExp.Pattern = "[^0-9a-zA-Z]"
    
    If lo_RegExp.test(as_string) Then
        f_remv_non_alphanum = lo_RegExp.Replace(as_string, "")
    Else
        f_remv_non_alphanum = Trim(as_string)
    End If
 
    Set lo_RegExp = Nothing
End Function

Public Function f_get_1st_value(ByVal as_string As String) As String
    If Len(Trim(as_string)) = 0 Then
        f_get_1st_value = ""
        Exit Function
    End If
    
    Dim li_i As Integer
    
    li_i = 0
    
    Dim lo_RegExp As New RegExp
    
    lo_RegExp.Global = True
    lo_RegExp.IgnoreCase = True
    
    lo_RegExp.Pattern = "[^0-9a-zA-Z]"

    While Len(f_get_1st_value) = 0
        f_get_1st_value = Trim(Split(as_string, ";")(li_i))

        If lo_RegExp.test(f_get_1st_value) Then
            f_get_1st_value = lo_RegExp.Replace(f_get_1st_value, "")
        End If
    
        li_i = li_i + 1
    Wend
    
    Set lo_RegExp = Nothing
End Function

Public Function f_get_mail_1st_value(ByVal as_string As String) As String
    If Len(Trim(as_string)) = 0 Then
        f_get_mail_1st_value = ""
        Exit Function
    End If
    
    Dim li_i As Integer
    
    li_i = 0
    
    While Len(f_get_mail_1st_value) = 0
        f_get_mail_1st_value = Trim(Split(as_string, ";")(li_i))
    
        li_i = li_i + 1
    Wend
End Function

Public Function f_is_file_or_folder(ByRef as_path As String)
    '=================================================================================================
    'normal case
    Const EXISTING_FILE = "EXISTING_FILE"
    Const EXISTING_FOLDER = "EXISTING_FOLDER"
    Const PARENT_FOLDER_EXISTS_NEW_FILE = "NEW_FILE"
    Const PARENT_FOLDER_EXISTS_NEW_FILE_NO_EXTENSION = "NEW_FILE_NO_EXTENSION"
    
    Const msg_NORMAL = "NORMAL"
    Const msg_PARENT_FOLDER_EXISTS_NEW_FILE = "Folder exists, but the file does not exist, regard it as a new file."
    Const msg_PARENT_FOLDER_EXISTS_NEW_FILE_NO_EXTENSION = "WARNING:Parent folder exists, but the file name is a new file, and has not extension."
    
    'error case
    Const WITH_SLASH_BUT_FOLDER_NOT_EXISTS = "ERROR_WITH_SLASH_BUT_FOLDER_NOT_EXISTS"
    Const msg_WITH_SLASH_BUT_FOLDER_NOT_EXISTS = "ERROR: The path followed by /, but the folder does not exists."
    
    Const FOLDER_OR_FILE_NOT_EXISTS = "ERROR_FOLDER_OR_FILE_NOT_EXISTS"
    Const msg_FOLDER_OR_FILE_NOT_EXISTS = "ERROR: The folder or file does not exist, please check the whole path."
    
    Const PATH_IS_BLANK = "ERROR_PATH_IS_BLANK"
    Const msg_PATH_IS_BLANK = "ERROR: the path is blank, please check it."
    
    Const PATH_NOT_FULL_PATH = "ERROR_PATH_IS_NOT_FULL_PATH"
    Const msg_PATH_NOT_FULL_PATH = "ERROR: the path is not full WINDOWS path, please use the full path. "
    
    Const OUT_OF_SCOPE = "ERROR_OUT_OF_SCOPE"
    Const msg_OUT_OF_SCOPE = "ERROR: Exception occurred, pls check the function f_is_file_or_folder."
    '=================================================================================================
   
    Dim ls_full_path As String
    Dim lo_fso As New FileSystemObject

    ls_full_path = Trim(as_path)
    
    ls_full_path = Replace(ls_full_path, "/", "\")
    
    If Len(ls_full_path) = 0 Then
        f_is_file_or_folder = Array(PATH_IS_BLANK, msg_PATH_IS_BLANK)
        Set lo_fso = Nothing
        Exit Function
    End If
    
    If InStr(ls_full_path, ":\") = 0 Then
        f_is_file_or_folder = Array(PATH_NOT_FULL_PATH, msg_PATH_NOT_FULL_PATH)
        Set lo_fso = Nothing
        Exit Function
    End If

    If lo_fso.FileExists(ls_full_path) Then 'this is a file name
        f_is_file_or_folder = Array(EXISTING_FILE, msg_NORMAL)
        Set lo_fso = Nothing
        Exit Function
    End If
    If lo_fso.FolderExists(ls_full_path) Then
        If Right(ls_full_path, 1) <> "\" Then
            as_path = ls_full_path & "\"
        End If

        f_is_file_or_folder = Array(EXISTING_FOLDER, msg_NORMAL)
        Set lo_fso = Nothing
        Exit Function
    End If

    'not a file, nor a folder
    If Right(ls_full_path, 1) = "\" Then
        f_is_file_or_folder = Array(WITH_SLASH_BUT_FOLDER_NOT_EXISTS, msg_WITH_SLASH_BUT_FOLDER_NOT_EXISTS)
        Set lo_fso = Nothing
        Exit Function
    Else
        If lo_fso.FolderExists(lo_fso.GetParentFolderName(ls_full_path)) Then
            If Len(lo_fso.GetExtensionName(ls_full_path)) > 0 Then
                f_is_file_or_folder = Array(PARENT_FOLDER_EXISTS_NEW_FILE, msg_PARENT_FOLDER_EXISTS_NEW_FILE)
            Else
                f_is_file_or_folder = Array(PARENT_FOLDER_EXISTS_NEW_FILE_NO_EXTENSION, msg_PARENT_FOLDER_EXISTS_NEW_FILE_NO_EXTENSION)
            End If
        
            Set lo_fso = Nothing
            Exit Function
        End If
        
        f_is_file_or_folder = Array(FOLDER_OR_FILE_NOT_EXISTS, msg_FOLDER_OR_FILE_NOT_EXISTS)
        Set lo_fso = Nothing
        Exit Function
    End If
    
    f_is_file_or_folder = Array(OUT_OF_SCOPE, msg_OUT_OF_SCOPE)
    Set lo_fso = Nothing
End Function


Public Sub sub_OpenFile(ByVal as_file_name As String)
    Dim Result As Long
 
    Result = ShellExecute(0&, vbNullString, as_file_name, _
    vbNullString, vbNullString, vbNormalFocus)
 
    If Result < 32 Then MsgBox "File open Error:" & as_file_name
End Sub