Excel Common Function 2

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



 
Option Explicit
Option Base 1

     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
                             
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(Dir(Split(ls_app_path, """")(1))) <= 0 Then
        ls_app_path = "D:\99.Software\UltraEdit17\Uedit32.exe %1"
    End If
    
    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)
    '=================================================================================================
    'return value :
    'array("ERROR_WITH_SLASH_BUT_FOLDER_NOT_EXISTS", "ERROR: The folder or file does not exist, please check the whole path.")
    
    '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
 

Option Explicit
Option Base 1

Const BATCH_REPLACE_CONFIG = "Batch Replace Configuration"

Public Sub sub_batch_replace()
    If Selection.Areas.Count > 1 Then
        MsgBox prompt:="The command command you chose cannot be performed " & _
                       "with multiple selections. " & _
                       Chr(13) & _
                       "Select a single range and try it again." _
             , Buttons:=vbCritical _
            , Title:="Attention!"
        
        Exit Sub
    End If
    
    Dim ldct_replace_pairs As New Dictionary
    Call sub_read_config_batch_replace(ldct_replace_pairs)
    
    If ldct_replace_pairs.Count <= 0 Then
        MsgBox "Nothing was found configured in the sheet [config]."
        Exit Sub
    End If
    
    Dim li_choice As Integer

    li_choice = MsgBox(prompt:="All files under the selected path will be overwrited, " & _
                               "it's recommended to backup the whole folders first. " & _
                                Chr(13) & _
                       " Continue?" _
                       , Buttons:=vbYesNo + vbCritical + vbDefaultButton2 _
                       , Title:="Attention!")
    
    If li_choice <> vbYes Then
        Exit Sub
    End If
    
    
    Dim lo_fso As New Scripting.FileSystemObject
    
    Dim lo_file As TextStream
    Dim ls_file_content As String
    Dim li_each_item As Integer
    
    Dim lo_reg_exp  As New VBScript_RegExp_55.RegExp
        
'    Dim lo_reg_exp
'    Set lo_reg_exp = CreateObject("vbScript.regexp")
    
    lo_reg_exp.IgnoreCase = True
    lo_reg_exp.Global = True
    
    lo_reg_exp.MultiLine = True
    
    Dim ls_txt_file_name As String
    Dim ls_folder_name As String
    
    Dim lo_source_folder As Folder
    Dim lo_sub_file As File
    Dim ls_file_filter As String
    
    Dim larr()
    
    Dim lo_each_row
    For Each lo_each_row In Selection.Rows
        ls_folder_name = Trim(ActiveSheet.Range("B" & lo_each_row.Row))
        ls_file_filter = Trim(ActiveSheet.Range("C" & lo_each_row.Row))
        
        larr = f_is_file_or_folder(ls_folder_name)
        
        If larr(1) <> "EXISTING_FILE" And larr(1) <> "EXISTING_FOLDER" Then
            MsgBox ls_folder_name & Chr(13) & larr(1) & Chr(13) & larr(2) & _
                    Chr(13) & _
                    Chr(13) & _
                    "The selected cells contain invalid path."
            Exit Sub
        End If
        
        If larr(1) = "EXISTING_FILE" Then
            ls_txt_file_name = ls_folder_name
            
            Set lo_file = lo_fso.OpenTextFile(ls_txt_file_name, ForReading, True)
            ls_file_content = lo_file.ReadAll
            lo_file.Close
                        
            For li_each_item = 0 To ldct_replace_pairs.Count - 1
                lo_reg_exp.Pattern = ldct_replace_pairs.Keys(li_each_item)
                ls_file_content = lo_reg_exp.Replace(ls_file_content, ldct_replace_pairs.Items(li_each_item))
            Next
            
            Set lo_file = lo_fso.OpenTextFile(ls_txt_file_name, ForWriting, True)
            lo_file.Write ls_file_content
        
            lo_file.Close
        ElseIf larr(1) = "EXISTING_FOLDER" Then
            Set lo_source_folder = lo_fso.GetFolder(ls_folder_name)
            
            If Len(ls_file_filter) = 0 Then ls_file_filter = "*"
            
            'sub files
            For Each lo_sub_file In lo_source_folder.Files
                ls_txt_file_name = lo_sub_file.Path
                
                Set lo_file = lo_fso.OpenTextFile(ls_txt_file_name, ForReading, True)
                ls_file_content = lo_file.ReadAll
                lo_file.Close
                            
                For li_each_item = 0 To ldct_replace_pairs.Count - 1
                    lo_reg_exp.Pattern = ldct_replace_pairs.Keys(li_each_item)
                    
                    If lo_reg_exp.test(ls_file_content) Then
                        ls_file_content = lo_reg_exp.Replace(ls_file_content, ldct_replace_pairs.Items(li_each_item))
                    End If
                Next
                
                Set lo_file = lo_fso.OpenTextFile(ls_txt_file_name, ForWriting, True)
                lo_file.Write ls_file_content
            
                lo_file.Close
            Next
        End If
    Next
    
    Set lo_file = Nothing
    Set lo_fso = Nothing
    Set lo_reg_exp = Nothing
    Set lo_source_folder = Nothing
    
    MsgBox "Replacing finished."
End Sub

Sub sub_read_config_batch_replace(ByRef ldct_replace_pairs)
    
    Dim ll_max_row As Long
    Dim larr_config
    
    ll_max_row = f_get_valid_data_max_row(ThisWorkbook.Worksheets("Config"))
    
    larr_config = ThisWorkbook.Worksheets("Config").Range("B1:D" & ll_max_row)
    
    If f_read_block_batch_replace(larr_config, _
                    BATCH_REPLACE_CONFIG, _
                    "BLOCK", _
                    ldct_replace_pairs, _
                    Empty, _
                    Empty) < 0 Then Exit Sub
        
End Sub

Function f_read_block_batch_replace(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_batch_replace = 0
            Exit Function
        Else
            MsgBox "Unable to read the config of " & as_config_label
            f_read_block_batch_replace = -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

        'find the start row and end row of the current block
        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 = 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
                    
                    If Not dct_filter.Exists(ls_key) Then
                        dct_filter(ls_key) = larr_config(ll_each_row, 3)
                    End If
                End If
            Next
        Else
            MsgBox "Unable to read the config of " & as_config_label
            f_read_block_batch_replace = -1
            Exit Function
        End If
        
'        If li_arr_cnt = 0 Then
'            arr_filter_regexp = Array()
'        End If
    End If
End Function


Public Sub sub_enlarge_min_lenth()

    On Error GoTo 0
    
    If Selection.Areas.Count > 1 Then
        MsgBox prompt:="The command command you chose cannot be performed " & _
                       "with multiple selections. " & _
                       Chr(13) & _
                       "Select a single range and try it again." _
             , Buttons:=vbCritical _
            , Title:="Attention!"
        
        Exit Sub
    End If
    
    Dim ll_curr_row As Long
    Dim ll_curr_col As Long
    
    ll_curr_row = ActiveCell.Row
    ll_curr_col = ActiveCell.Column
    
    If ActiveSheet.Columns(ll_curr_col).ColumnWidth > 30 Then
        ActiveSheet.Columns(ll_curr_col).ColumnWidth = 30
    Else
    
        ActiveSheet.Columns(ll_curr_col).EntireColumn.AutoFit
    End If
    
    
    ActiveSheet.Rows(ll_curr_row).EntireRow.AutoFit
    
    
End Sub