Excel VBA common functions

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 Sub sub_compose_header(ByVal ai_repeat_times As Integer)
    Dim ll_col_no_from As Long
    Dim ll_col_no_to As Long
    Dim li_repeat_cnt As Integer
    
    'set the header, base part
    ll_col_no_from = 1
    ll_col_no_to = UBound(garr_header_base)
    ThisWorkbook.Worksheets(gs_report_name).Cells(1, ll_col_no_from).Resize(1, ll_col_no_to) = garr_header_base
    
    'set the header, repeat part
    li_repeat_cnt = 1
    ll_col_no_from = ll_col_no_to + 1
    
    Do While li_repeat_cnt <= ai_repeat_times
        ThisWorkbook.Worksheets(gs_report_name).Cells(1, ll_col_no_from).Resize(1, UBound(garr_header_repeat)) = garr_header_repeat
        
        ll_col_no_from = ll_col_no_from + UBound(garr_header_repeat)
        li_repeat_cnt = li_repeat_cnt + 1
    Loop
End Sub

Public Sub sub_compose_format()
    On Error GoTo 0
    
    Dim ll_each_row As Long
    Dim ll_start_row As Long
    Dim ll_end_row As Long
    Dim ll_col_count As Long
    
    Dim ls_appendix As String
    
    Dim ls_range
    Dim li_i As Integer
    
    Sheets(gs_report_name).Activate

    ll_start_row = Sheets(gs_report_name).UsedRange.Row
    ll_end_row = ll_start_row + Sheets(gs_report_name).UsedRange.Rows.Count - 1

    ll_col_count = Sheets(gs_report_name).Range("A1").CurrentRegion.Columns.Count
    
    Sheets(gs_report_name).Range(Cells(1, 1), Cells(1, ll_col_count)).Font.Bold = False
    
    Sheets(gs_report_name).Cells.EntireColumn.AutoFit
    
    'set the report line style
    Dim lo_rng As Range
    Set lo_rng = Sheets(gs_report_name).Range(Cells(1, 1), Cells(ll_end_row, ll_col_count))
    
    lo_rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
    lo_rng.Borders(xlEdgeTop).LineStyle = xlContinuous
    lo_rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
    lo_rng.Borders(xlEdgeRight).LineStyle = xlContinuous
    lo_rng.Borders(xlInsideVertical).LineStyle = xlContinuous
    lo_rng.Borders(xlInsideHorizontal).LineStyle = xlContinuous

    'Set column rec no.
    For li_i = 1 To UBound(g_static_col_color)
        If li_i = 1 Then
            ls_range = g_static_col_color(li_i) & ll_start_row & ":" & g_static_col_color(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_static_col_color(li_i) & ll_start_row & ":" & g_static_col_color(li_i) & ll_end_row
        End If
    Next

    If UBound(g_static_col_color) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.Interior.ThemeColor = xlThemeColorAccent2
        lo_rng.Interior.TintAndShade = 0.799981688894314
    End If
    
    'FDM color
    For li_i = 1 To UBound(g_fdm_color_col)
        If li_i = 1 Then
            ls_range = g_fdm_color_col(li_i) & ll_start_row & ":" & g_fdm_color_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_fdm_color_col(li_i) & ll_start_row & ":" & g_fdm_color_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_fdm_color_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.Interior.Color = 5296274
    End If
    
    'TICS color
    For li_i = 1 To UBound(g_tics_color_col)
        If li_i = 1 Then
            ls_range = g_tics_color_col(li_i) & ll_start_row & ":" & g_tics_color_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_tics_color_col(li_i) & ll_start_row & ":" & g_tics_color_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_tics_color_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.Interior.ThemeColor = xlThemeColorLight2
        lo_rng.Interior.TintAndShade = 0.799981688894314
    End If
    
    'TMS base color
    For li_i = 1 To UBound(g_tms_base_color_col)
        If li_i = 1 Then
            ls_range = g_tms_base_color_col(li_i) & ll_start_row & ":" & g_tms_base_color_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_tms_base_color_col(li_i) & ll_start_row & ":" & g_tms_base_color_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_tms_base_color_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.Interior.Color = 49407
    End If
    
    'cis color
    For li_i = 1 To UBound(g_cis_color_col)
        If li_i = 1 Then
            ls_range = g_cis_color_col(li_i) & ll_start_row & ":" & g_cis_color_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_cis_color_col(li_i) & ll_start_row & ":" & g_cis_color_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_cis_color_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.Interior.ThemeColor = xlThemeColorAccent1
        lo_rng.Interior.TintAndShade = 0.399975585192419
    End If
    
    '========== dynamic set the format for repeated columns =========================
    'Dim dict_col_indx As New Dictionary
    'Call sub_init_col_indx_alpha(dict_col_indx)
    
    Dim li_each_time As Integer
    
    Dim li_col_no As Integer
    
    For li_each_time = 1 To gi_header_repeat_cnt
        'cis color
        For li_i = 1 To UBound(g_rpt_cis_color_col)
            li_col_no = dict_col_indx(g_rpt_cis_color_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(ll_start_row, li_col_no), Sheets(gs_report_name).Cells(ll_end_row, li_col_no)).Address
            Else
                ls_range = ls_range & "," & Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(ll_start_row, li_col_no), Sheets(gs_report_name).Cells(ll_end_row, li_col_no)).Address
            End If
        Next
    
        If UBound(g_rpt_cis_color_col) > 0 Then
            Set lo_rng = Sheets(gs_report_name).Range(ls_range)
            lo_rng.Interior.ThemeColor = xlThemeColorAccent1
            lo_rng.Interior.TintAndShade = 0.399975585192419
        End If
        
        'ifop color
        For li_i = 1 To UBound(g_rpt_ifop_color_col)
            li_col_no = dict_col_indx(g_rpt_ifop_color_col(li_i)) + gi_rpt_col_num * (li_each_time - 1)
            
            If li_i = 1 Then
                ls_range = Sheets(gs_report_name).Range(Cells(ll_start_row, li_col_no), Cells(ll_end_row, li_col_no)).Address
            Else
                ls_range = ls_range & "," & Sheets(gs_report_name).Range(Cells(ll_start_row, li_col_no), Cells(ll_end_row, li_col_no)).Address
            End If
        Next
    
        If UBound(g_rpt_ifop_color_col) > 0 Then
            Set lo_rng = Sheets(gs_report_name).Range(ls_range)
            lo_rng.Interior.Color = 15773696
        End If
        
        'tms color
        For li_i = 1 To UBound(g_rpt_tms_color_col)
            li_col_no = dict_col_indx(g_rpt_tms_color_col(li_i)) + gi_rpt_col_num * (li_each_time - 1)
            
            If li_i = 1 Then
                ls_range = Sheets(gs_report_name).Range(Cells(ll_start_row, li_col_no), Cells(ll_end_row, li_col_no)).Address
            Else
                ls_range = ls_range & "," & Sheets(gs_report_name).Range(Cells(ll_start_row, li_col_no), Cells(ll_end_row, li_col_no)).Address
            End If
        Next
    
        If UBound(g_rpt_tms_color_col) > 0 Then
            Set lo_rng = Sheets(gs_report_name).Range(ls_range)
            lo_rng.Interior.Color = 49407
        End If
    Next

    '--------------------------------------------------------------
    'date format
'    For li_i = 1 To UBound(g_date_col)
'        If li_i = 1 Then
'            ls_range = g_date_col(li_i) & ll_start_row & ":" & g_date_col(li_i) & ll_end_row
'        Else
'            ls_range = ls_range & "," & g_date_col(li_i) & ll_start_row & ":" & g_date_col(li_i) & ll_end_row
'        End If
'    Next
'
'    If UBound(g_date_col) > 0 Then
'        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
'        lo_rng.NumberFormat = "dd\/mm\/yyyy"
'    End If
    
    'decimal format
    For li_i = 1 To UBound(g_dec_col)
        If li_i = 1 Then
            ls_range = g_dec_col(li_i) & ll_start_row & ":" & g_dec_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_dec_col(li_i) & ll_start_row & ":" & g_dec_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_dec_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.NumberFormat = "#,##0.00;[Red]-#,##0.00"
    End If
    
    'rate format
    For li_i = 1 To UBound(g_rate_col)
        If li_i = 1 Then
            ls_range = g_rate_col(li_i) & ll_start_row & ":" & g_rate_col(li_i) & ll_end_row
        Else
            ls_range = ls_range & "," & g_rate_col(li_i) & ll_start_row & ":" & g_rate_col(li_i) & ll_end_row
        End If
    Next

    If UBound(g_rate_col) > 0 Then
        Set lo_rng = Sheets(gs_report_name).Range(ls_range)
        lo_rng.NumberFormat = "#,##0.0000;[Red]-#,##0.0000"
    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(g_rpt_date_col)
'            li_col_no = dict_col_indx(g_rpt_date_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(ll_start_row, li_col_no), Sheets(gs_report_name).Cells(ll_end_row, li_col_no)).Address
'            Else
'                ls_range = ls_range & "," & Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(ll_start_row, li_col_no), Sheets(gs_report_name).Cells(ll_end_row, li_col_no)).Address
'            End If
'        Next
'
'        If UBound(g_rpt_date_col) > 0 Then
'            Set lo_rng = Sheets(gs_report_name).Range(ls_range)
'            'lo_rng.NumberFormat = "dd\/mm\/yyyy"
'            lo_rng.NumberFormat = "@"
'        End If
'    Next
    '---------------------------------------------------------
        
    'if the column is too long, shorten it, to make read easy
    For li_col_no = dict_col_indx(gs_rpt_col_after) To ll_col_count
        If Columns(li_col_no).ColumnWidth > 30 Then Columns(li_col_no).ColumnWidth = 30
    Next
    
    'set legend
    ls_appendix = "B" & CStr(ll_end_row + 2): ll_end_row = ll_end_row + 3
    Range(ls_appendix) = "LEGEND:"
    Range(ls_appendix).Font.Name = "Times New Roman"
    Range(ls_appendix).Font.Size = 12
    Range(ls_appendix).Font.Bold = True
    
    ls_appendix = "B" & CStr(ll_end_row): ll_end_row = ll_end_row + 1
    Range(ls_appendix) = "FDM"
    Range(ls_appendix).Interior.Color = 5296274
    
    If gdict_csv.Exists("merival") Then
        Range(ls_appendix) = Range(ls_appendix) & " / Merival"
    End If
    
    If gdict_csv.Exists("clt_rpt") Then
        Range(ls_appendix) = Range(ls_appendix) & " / ClientReporting"
    End If
    
    If gdict_csv.Exists("tics") Then
        ls_appendix = "B" & CStr(ll_end_row): ll_end_row = ll_end_row + 1
        Range(ls_appendix) = "TICS"
        Range(ls_appendix).Interior.ThemeColor = xlThemeColorLight2
        Range(ls_appendix).Interior.TintAndShade = 0.799981688894314
    End If
    
    ls_appendix = "B" & CStr(ll_end_row): ll_end_row = ll_end_row + 1
    Range(ls_appendix) = "CIS"
    Range(ls_appendix).Interior.ThemeColor = xlThemeColorAccent1
    Range(ls_appendix).Interior.TintAndShade = 0.399975585192419

    ls_appendix = "B" & CStr(ll_end_row): ll_end_row = ll_end_row + 1
    Range(ls_appendix) = "TMS"
    Range(ls_appendix).Interior.Color = 49407

    If gdict_csv.Exists("ifop") Then
        ls_appendix = "B" & CStr(ll_end_row): ll_end_row = ll_end_row + 1
        Range(ls_appendix).FormulaR1C1 = "Ifop"
        Range(ls_appendix).Interior.Color = 15773696
    End If
    
'    Dim ll_last_row As Long
'    ll_last_row = f_get_valid_data_max_row(ActiveSheet)
'
'    Range("D" & (ll_last_row - 2) & ":L" & ll_last_row).Merge
'    Range("D" & (ll_last_row - 2)) = "The date column is in TEXT format, please do not fomat them to DATE."
'    Range("D" & (ll_last_row - 2)).Font.ColorIndex = 3
'    Range("D" & (ll_last_row - 2)).Font.Size = 14
'    Range("D" & (ll_last_row - 2)).VerticalAlignment = xlTop
'    Range("D" & (ll_last_row - 2)).WrapText = True
    
    'set zoom
    Range("A1").Select
    ActiveWindow.Zoom = 85
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.SplitColumn = 3
    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True
End Sub

Public Sub sub_format_sheets()
    On Error Resume Next
    
    Sheets(gdict_report_name.Keys(0)).Move before:=ThisWorkbook.Sheets(1)
    Sheets(gdict_report_name.Keys(1)).Move before:=ThisWorkbook.Sheets(2)
    Sheets(gdict_report_name.Keys(2)).Move after:=ThisWorkbook.Sheets(3)
    'Sheets(gdict_report_name.Keys(2)).Move after:=ThisWorkbook.Sheets(Worksheets.Count)

'    If f_if_sheet_exists(gdict_report_name.Keys(0)) And Worksheets.Count > 1 Then
'        If Sheets(1).Name <> gdict_report_name.Keys(0) Then
'            Sheets(gdict_report_name.Keys(0)).Move before:=ThisWorkbook.Sheets(1)
'        End If
'    End If
'
'    If f_if_sheet_exists(gdict_report_name.Keys(1)) And Worksheets.Count > 1 Then
'        If Sheets(2).Name <> gdict_report_name.Keys(1) Then
'            Sheets(gdict_report_name.Keys(1)).Move before:=ThisWorkbook.Sheets(2)
'        End If
'    End If
'
'    If f_if_sheet_exists(gdict_report_name.Keys(2)) And Worksheets.Count > 1 Then
'        If Sheets(2).Name <> gdict_report_name.Keys(1) Then
'            Sheets(gdict_report_name.Keys(1)).Move before:=ThisWorkbook.Sheets(2)
'        End If
'    End If
    
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    
    If f_if_sheet_exists(gdict_report_name.Keys(0)) Then Sheets(gdict_report_name.Keys(0)).Tab.Color = 5296274
    If f_if_sheet_exists(gdict_report_name.Keys(1)) Then Sheets(gdict_report_name.Keys(1)).Tab.Color = 10498160
    If f_if_sheet_exists(gdict_report_name.Keys(2)) Then Sheets(gdict_report_name.Keys(2)).Tab.Color = 49407
    
    Sheets(gs_report_name).Activate
    
    On Error GoTo 0
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 Function f_compare_ah_names(ByVal as_main_ptfl _
                                 , ByVal dct_no_of_memb _
                                 , ByVal dct_cis_row_from _
                                 , ByVal dct_cis_row_to _
                                 , ByVal arr_cis _
                                 , ByVal dct_tms_gurt _
                                 ) As String
    On Error GoTo 0
    
    Dim larr_gurtors
    Dim li_each_gur As Integer
    Dim li_max_gurtors As Integer
        
    Dim ll_cis_row_no As Long
    Dim ll_cis_row_from As Long
    Dim ll_cis_row_to As Long
    
    Dim ll_cis_row_no_gur As Long
    Dim ll_cis_row_fr_gur As Long
    Dim ll_cis_row_to_gur As Long
    
    If dct_tms_gurt.Exists(as_main_ptfl) Then   ' TMS_3 has gurantor of this ptfl
        larr_gurtors = Split(dct_tms_gurt(as_main_ptfl), "|")
        li_max_gurtors = UBound(larr_gurtors)
        
        'when cis has no such record
        If IsEmpty(dct_no_of_memb(as_main_ptfl)) Then
            f_compare_ah_names = gs_EXCEPTION
            Exit Function
        End If

        'if the no_of_memebers of this ptfl is diff from any one of the gurantors, then G.
        For li_each_gur = 1 To li_max_gurtors
            'when cis has no such record
            If IsEmpty(dct_no_of_memb(CDbl(larr_gurtors(li_each_gur)))) Then
                f_compare_ah_names = gs_EXCEPTION
                Exit Function
            End If
        
            If dct_no_of_memb(as_main_ptfl) <> dct_no_of_memb(CDbl(larr_gurtors(li_each_gur))) Then
                f_compare_ah_names = "G"
                Exit Function
            End If
        Next
        
        'check if all of AH names of this ptfl are same as all AH names of all gurantor
        ll_cis_row_from = dct_cis_row_from(as_main_ptfl)
        ll_cis_row_to = dct_cis_row_to(as_main_ptfl)
            
        For ll_cis_row_no = ll_cis_row_from To ll_cis_row_to    ' all AH of the main ptfl
            For li_each_gur = 1 To li_max_gurtors
                ll_cis_row_fr_gur = dct_cis_row_from(CDbl(larr_gurtors(li_each_gur)))
                ll_cis_row_to_gur = dct_cis_row_to(CDbl(larr_gurtors(li_each_gur)))
                
                For ll_cis_row_no_gur = ll_cis_row_fr_gur To ll_cis_row_to_gur    ' all AH of the this gurantor
                    If arr_cis(ll_cis_row_no, dict_col_indx("I")) <> arr_cis(ll_cis_row_no_gur, dict_col_indx("I")) Then
                        f_compare_ah_names = "G"
                        Exit Function
                    End If
                Next
            Next
        Next
    End If

    f_compare_ah_names = "N"
End Function

Public Function f_get_data_of_csv_file(ByVal as_csv_file_tag As String _
                                     , ByRef arr_csv) As Integer
    
    Dim ls_csv_sheet As String
    Dim ll_start_row As Long
    Dim ll_end_row As Long
    
    ls_csv_sheet = gdict_csv(as_csv_file_tag)
    ll_start_row = Sheets(ls_csv_sheet).UsedRange.Row       ' ll_start_row = 1
    ll_end_row = ll_start_row + Sheets(ls_csv_sheet).UsedRange.Rows.Count - 1
    
    If ll_start_row = ll_end_row Then
        f_get_data_of_csv_file = 100
       'arr_csv = Array()
        Exit Function
    End If
    
    ll_start_row = ll_start_row + 1                         ' ll_start_row = 2
    
    arr_csv = Sheets(ls_csv_sheet).Range(Sheets(ls_csv_sheet).Cells(ll_start_row, 1), Sheets(ls_csv_sheet).Cells(ll_end_row, Sheets(ls_csv_sheet).UsedRange.Columns.Count))

    f_get_data_of_csv_file = 0
End Function

Public Sub sub_add_address_column(ByVal adoStream As ADODB.Stream _
                                , ByVal ldct_cis_row_from As Dictionary _
                                , ByVal larr_cis)
    Dim ll_max_col_no   As Long
    Dim ll_end_row      As Long
    Dim ll_each_row     As Long
    
    On Error GoTo 0
    
    ll_max_col_no = Sheets(gs_report_name).UsedRange.Columns.Count
    ll_end_row = Sheets(gs_report_name).UsedRange.Rows.Count
    
    ' add 6 address 1, 2, 3, 4, 5, 6
    ll_max_col_no = ll_max_col_no + 12

    Dim li_add_col1 As Integer, li_add_col2 As Integer, li_add_col3 As Integer, li_add_col4 As Integer, li_add_col5 As Integer, li_add_col6 As Integer
    Dim li_add_col7 As Integer, li_add_col8 As Integer, li_add_col9 As Integer, li_add_col10 As Integer, li_add_col11 As Integer, li_add_col12 As Integer

    li_add_col1 = ll_max_col_no - 11
    li_add_col2 = ll_max_col_no - 10
    li_add_col3 = ll_max_col_no - 9
    li_add_col4 = ll_max_col_no - 8
    li_add_col5 = ll_max_col_no - 7
    li_add_col6 = ll_max_col_no - 6
    li_add_col7 = ll_max_col_no - 5
    li_add_col8 = ll_max_col_no - 4
    li_add_col9 = ll_max_col_no - 3
    li_add_col10 = ll_max_col_no - 2
    li_add_col11 = ll_max_col_no - 1
    li_add_col12 = ll_max_col_no

    Sheets(gs_report_name).Cells(1, li_add_col1) = "POSTAL_ADDR_LINE_1"
    Sheets(gs_report_name).Cells(1, li_add_col2) = "POSTAL_ADDR_LINE_2"
    Sheets(gs_report_name).Cells(1, li_add_col3) = "POSTAL_ADDR_LINE_3"
    Sheets(gs_report_name).Cells(1, li_add_col4) = "POSTAL_ADDR_LINE_4"
    Sheets(gs_report_name).Cells(1, li_add_col5) = "POSTAL_ADDR_LINE_5"
    Sheets(gs_report_name).Cells(1, li_add_col6) = "POSTAL_ADDR_LINE_6"
    Sheets(gs_report_name).Cells(1, li_add_col7) = "ADDR1_Length" & Chr(13) & Chr(10) & "(Bytes)"
    Sheets(gs_report_name).Cells(1, li_add_col8) = "ADDR2_Length" & Chr(13) & Chr(10) & "(Bytes)"
    Sheets(gs_report_name).Cells(1, li_add_col9) = "ADDR3_Length" & Chr(13) & Chr(10) & "(Bytes)"
    Sheets(gs_report_name).Cells(1, li_add_col10) = "ADDR4_Length" & Chr(13) & Chr(10) & "(Bytes)"
    Sheets(gs_report_name).Cells(1, li_add_col11) = "ADDR5_Length" & Chr(13) & Chr(10) & "(Bytes)"
    Sheets(gs_report_name).Cells(1, li_add_col12) = "ADDR6_Length" & Chr(13) & Chr(10) & "(Bytes)"

    Dim larr_acc_num
    larr_acc_num = Sheets(gs_report_name).Range("C2:C" & ll_end_row)

    Dim larr_address
    larr_address = Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(2, li_add_col1) _
                                            , Sheets(gs_report_name).Cells(ll_end_row, li_add_col12))

    Dim ll_cis_row_from As Long
    Dim ll_cis_col_start As Long
    Dim ll_cis_col_no As Long
    Dim ls_addr_line1 As String
    Dim ls_retain_mail As String
    Dim li_addr_col As Integer

    For ll_each_row = 1 To UBound(larr_address, 1)
        ll_cis_row_from = ldct_cis_row_from(larr_acc_num(ll_each_row, 1))
        
        If ll_cis_row_from > 0 Then
            ls_addr_line1 = larr_cis(ll_cis_row_from, dict_col_indx("AC"))
            ls_retain_mail = larr_cis(ll_cis_row_from, dict_col_indx("AD"))
            
            If ls_retain_mail = "02" Then                   'retained mail
                ll_cis_col_start = dict_col_indx("Z")       'start from address line 4
            Else
                ll_cis_col_start = dict_col_indx("W")
                
                'check the real address line stores in which field, then the address lines before that should be partner name
                'so discard those field before
                If Len(Trim(ls_addr_line1)) > 0 Then
                    For ll_cis_col_no = dict_col_indx("W") To dict_col_indx("AB")
                        If UCase(larr_cis(ll_cis_row_from, ll_cis_col_no)) = UCase(ls_addr_line1) Then
                            ll_cis_col_start = ll_cis_col_no
                            Exit For
                        End If
                    Next
                End If
            End If
            
            li_addr_col = 1
            'li_addr_col = ll_cis_col_start - dict_col_indx("W") + 1
            
            For ll_cis_col_no = ll_cis_col_start To dict_col_indx("AB")
                larr_address(ll_each_row, li_addr_col) = larr_cis(ll_cis_row_from, ll_cis_col_no)
                li_addr_col = li_addr_col + 1
            Next
    
            larr_address(ll_each_row, 7) = f_LenByBytes(adoStream, larr_address(ll_each_row, 1))
            larr_address(ll_each_row, 8) = f_LenByBytes(adoStream, larr_address(ll_each_row, 2))
            larr_address(ll_each_row, 9) = f_LenByBytes(adoStream, larr_address(ll_each_row, 3))
            larr_address(ll_each_row, 10) = f_LenByBytes(adoStream, larr_address(ll_each_row, 4))
            larr_address(ll_each_row, 11) = f_LenByBytes(adoStream, larr_address(ll_each_row, 5))
            larr_address(ll_each_row, 12) = f_LenByBytes(adoStream, larr_address(ll_each_row, 6))
        Else
            larr_address(ll_each_row, 7) = 0
            larr_address(ll_each_row, 8) = 0
            larr_address(ll_each_row, 9) = 0
            larr_address(ll_each_row, 10) = 0
            larr_address(ll_each_row, 11) = 0
            larr_address(ll_each_row, 12) = 0
        End If
    Next
        
    Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(2, li_add_col1) _
                               , Sheets(gs_report_name).Cells(UBound(larr_address, 1) + 1, ll_max_col_no) _
                                ).NumberFormat = "@"
    
    Sheets(gs_report_name).Cells(2, li_add_col1).Resize(UBound(larr_address, 1), 12) = larr_address
End Sub

Public Sub sub_add_names_column(ByVal adoStream As ADODB.Stream _
                              , ByVal ldct_cis_row_from As Dictionary _
                              , ByVal larr_cis)
    Dim ll_max_col_no   As Long
    Dim ll_end_row      As Long
    
    On Error GoTo 0
    
    ll_max_col_no = Sheets(gs_report_name).UsedRange.Columns.Count
    ll_end_row = Sheets(gs_report_name).UsedRange.Rows.Count
        
    Sheets(gs_report_name).Cells(1, ll_max_col_no) = "AH_NAME"
    Sheets(gs_report_name).Cells(1, ll_max_col_no + 1) = "ADDITIONAL_NAME1"
    Sheets(gs_report_name).Cells(1, ll_max_col_no + 2) = "ADDITIONAL_NAME2"
    
    Dim larr_acc_num
    larr_acc_num = Sheets(gs_report_name).Range("C2:C" & ll_end_row)

    Dim larr_names
    larr_names = Sheets(gs_report_name).Range(Sheets(gs_report_name).Cells(2, ll_max_col_no) _
                                            , Sheets(gs_report_name).Cells(ll_end_row, ll_max_col_no + 2))

    For ll_each_row = 1 To UBound(larr_names, 1)
        larr_names(ll_each_row, 1) = larr_cis(ldct_cis_row_from(larr_acc_num(ll_each_row, 1)), dict_col_indx("AC"))
        larr_names(ll_each_row, 2) = larr_cis(ldct_cis_row_from(larr_acc_num(ll_each_row, 1)), dict_col_indx("AD"))
        larr_names(ll_each_row, 3) = larr_cis(ldct_cis_row_from(larr_acc_num(ll_each_row, 1)), dict_col_indx("AE"))
    Next

    Sheets(gs_report_name).Cells(2, ll_max_col_no).Resize(UBound(larr_names, 1), 3) = larr_names

End Sub


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



Public Sub sub_get_clt_id_br_rpt_a_c(ByVal as_csv_tag As String _
                                   , ByRef ldct_cis_row_from _
                                   , ByRef ldct_cis_row_to _
                                   , ByRef larr_cis _
                                   , ByRef ldct_c_clt_id_no _
                                   , ByRef ldct_c_clt_cert _
                                     )
    
    Dim ll_rtn_code As Integer
    
    'FDM part C
    Dim larr_csv
    ll_rtn_code = f_get_data_of_csv_file(as_csv_tag, larr_csv)
        
    'get fdm c 's client
    Dim ll_cis_row_no As Long
    Dim ll_cis_row_from As Long
    Dim ll_cis_row_to As Long
    Dim ls_acc_num
    Dim ls_id_num As String
    Dim ls_cert As String
    Dim larr_split
    Dim li_each_item As Integer
    Dim ll_each_row As Long
    
    For ll_each_row = 1 To UBound(larr_csv, 1)
        If as_csv_tag = "fdm_c" Then
            If larr_csv(ll_each_row, dict_col_indx("H")) = gs_OVERDRAFT Then
                GoTo next_for
            End If
        End If

        If as_csv_tag = "clt_rpt" Then
            ls_acc_num = larr_csv(ll_each_row, dict_col_indx("D"))
        Else
            ls_acc_num = larr_csv(ll_each_row, dict_col_indx("C"))
        End If
        
        ll_cis_row_from = ldct_cis_row_from(ls_acc_num)
        ll_cis_row_to = ldct_cis_row_to(ls_acc_num)
        
        If ll_cis_row_from > 0 Then
            For ll_cis_row_no = ll_cis_row_from To ll_cis_row_to
                'id number
                larr_split = Split(larr_cis(ll_cis_row_no, dict_col_indx("L")), ";")
                
                For li_each_item = 0 To UBound(larr_split)
                    ls_id_num = f_remv_non_alphanum(larr_split(li_each_item))
                    
                    If Len(ls_id_num) > 0 Then
                        If Not ldct_c_clt_id_no.Exists(ls_id_num) Then
                            ldct_c_clt_id_no(ls_id_num) = 1
                        End If
                    End If
                Next
                
                'cert
                larr_split = Split(larr_cis(ll_cis_row_no, dict_col_indx("N")), ";")
                
                For li_each_item = 0 To UBound(larr_split)
                    ls_cert = f_remv_non_alphanum(larr_split(li_each_item))
                    
                    If Len(ls_cert) > 0 Then
                        If Not ldct_c_clt_cert.Exists(ls_cert) Then
                            ldct_c_clt_cert(ls_cert) = 1
                        End If
                    End If
                Next
            Next
        End If
next_for:
    Next

End Sub

Public Sub sub_get_dbtor_depstor_ind(ByVal as_report As String _
                                   , ByVal as_id_num As String _
                                   , ByVal as_cert_num As String _
                                   , ByRef ldct_c_clt_id_no _
                                   , ByRef ldct_c_clt_cert _
                                   , ByRef ls_flg As String _
                                   , ByRef ls_id_num_matched _
                                     )
    ls_flg = "N"
    ls_id_num_matched = ""
    
    Dim ls_id_num As String
    Dim ls_cert As String
    Dim larr_split
    Dim li_each_item As Integer
    
    'id number
    larr_split = Split(as_id_num, ";")
    
    For li_each_item = 0 To UBound(larr_split)
        ls_id_num = f_remv_non_alphanum(larr_split(li_each_item))
        
        If Len(ls_id_num) > 0 Then
            If ldct_c_clt_id_no.Exists(ls_id_num) Then
               ls_flg = "Y"
               ls_id_num_matched = ls_id_num
               
               Exit For
            End If
        End If
    Next
    
    If as_report = "C" Then Exit Sub
    
    'cert
    If ls_flg = "N" Then
        larr_split = Split(as_cert_num, ";")
        
        For li_each_item = 0 To UBound(larr_split)
            ls_cert = f_remv_non_alphanum(larr_split(li_each_item))
            
            If Len(ls_cert) > 0 Then
                If ldct_c_clt_cert.Exists(ls_cert) Then
                   ls_flg = "Y"
                   
                   Exit For
                End If
            End If
        Next
    End If
End Sub



Option Explicit
Option Base 1

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 And li_i <= UBound(Split(as_string, ";"))
        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

 


Private Sub sub_gen_utf8_textfile(ByVal as_output_file As String)
    Dim ls_spaces As String
    Dim ls_zeros As String
    
    Dim larr_report
    
    Dim ll_each_row As Long
    Dim ll_max_row As Long
    Dim ll_each_col As Integer
    'Dim ll_max_col As Integer
    
    ls_spaces = String(100, " ")
    ls_zeros = String(100, "0")
    
    'Dim dict_col_indx As New Dictionary
    'Call sub_init_col_indx_alpha(dict_col_indx)
    
    larr_report = ThisWorkbook.Worksheets(gs_report_name).Range("A1").CurrentRegion
    
    ll_max_row = UBound(larr_report, 1)
    'll_max_col = UBound(larr_report, 2)
    
    Dim li_each_deposit As Integer
    'Dim li_repeat_cnt As Integer
    'li_repeat_cnt = (ll_max_col - dict_col_indx(gs_rpt_col_after)) / gi_rpt_col_num
    
    Dim larr_no_of_memeber
    Dim li_addr_col_start As Integer
    
    larr_no_of_memeber = ThisWorkbook.Worksheets(gs_report_name).Range(gs_no_of_memb_col & "2:" & gs_no_of_memb_col & ll_max_row)
    li_addr_col_start = dict_col_indx(gs_rpt_col_after) + Application.Max(larr_no_of_memeber) * gi_rpt_col_num + 1
    
    Dim ll_rec_num As Long
    Dim ldc_sum_prcp_bal As Double
        
    Dim ls_each_record
    Dim ls_col_a, ls_col_b, ls_col_c, ls_col_d, ls_col_e, ls_col_f, ls_col_g, ls_col_h, ls_col_i
    Dim ls_col_j, ls_col_k, ls_col_l, ls_col_m, ls_col_n, ls_col_o, ls_col_p, ls_col_q, ls_col_r
    Dim ls_col_s, ls_col_t, ls_col_u, ls_col_w, ls_col_v, ls_col_x, ls_col_y
    
    ldc_sum_prcp_bal = 0
    For ll_each_row = 2 To ll_max_row
        ldc_sum_prcp_bal = ldc_sum_prcp_bal + larr_report(ll_each_row, dict_col_indx("F")) 'nominal value/quantity
    Next
    
    ll_rec_num = larr_report(ll_max_row, dict_col_indx("A"))

    Dim lo_output As New ADODB.Stream
    
    lo_output.Type = 2
    lo_output.Charset = "UTF-8"
    lo_output.Open
    
    ' for truncate address
    Dim adoStream As New ADODB.Stream
    
    adoStream.Type = 2
    adoStream.Charset = "UTF-8"
    adoStream.Open
    
    lo_output.WriteText (Left("UBS" & ls_spaces, 10) & _
                         Format(ll_rec_num, "0000000000") & _
                         Format(ldc_sum_prcp_bal, "0000000000000000000.0000000000;-000000000000000000.0000000000") _
                         ), adWriteLine
    
    For ll_each_row = 2 To ll_max_row
        ls_each_record = Empty
        
        ls_col_a = larr_report(ll_each_row, dict_col_indx("A"))  'Record number
        ls_col_b = larr_report(ll_each_row, dict_col_indx("B"))  'deposit type code, 10 is short, need toconfirm
        ls_col_c = larr_report(ll_each_row, dict_col_indx("C"))  'account number
        ls_col_d = larr_report(ll_each_row, dict_col_indx("D"))
        ls_col_e = larr_report(ll_each_row, dict_col_indx("E"))
        ls_col_f = larr_report(ll_each_row, dict_col_indx("F"))
        ls_col_g = larr_report(ll_each_row, dict_col_indx("G"))
        ls_col_h = larr_report(ll_each_row, dict_col_indx("H"))
        ls_col_i = larr_report(ll_each_row, dict_col_indx("I"))
        ls_col_j = larr_report(ll_each_row, dict_col_indx("J"))
        ls_col_k = larr_report(ll_each_row, dict_col_indx("K"))
        ls_col_l = larr_report(ll_each_row, dict_col_indx("L"))
        
        'ls_each_record = ls_each_record & StrConv(larr_report(ll_each_row, ll_each_col), vbUnicode)
        ls_each_record = Right(ls_zeros & ls_col_a, 10) & _
                         Left(ls_col_b & ls_spaces, 10) & _
                         Right(ls_zeros & ls_col_c, 30) & _
                         Left(ls_col_d & ls_spaces, 30) & _
                         Left(ls_col_e & ls_spaces, 3) & _
                         Format(CDec(ls_col_f), "+000000000000000000.0000000000;-000000000000000000.0000000000") & _
                         Format(CDec(ls_col_g), "+000000000000000000.0000000000;-000000000000000000.0000000000") & _
                         f_date_rm_slash(ls_col_h) & _
                         Right(ls_zeros & ls_col_i, 3) & _
                         Left(ls_col_j & ls_spaces, 1) & _
                         Left(ls_col_k & ls_spaces, 1) & _
                         Left(Format(ls_col_l, "000") & ls_spaces, 3)
        
        lo_output.WriteText ls_each_record

        ls_each_record = Empty
        
        If IsNull(ls_col_i) Or IsEmpty(ls_col_i) Then
            ls_col_i = 0
        End If
        
        'Each Depositor Information
       'For li_each_deposit = 0 To li_repeat_cnt - 1
        For li_each_deposit = 0 To ls_col_i - 1
            ls_col_m = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("M"))
            ls_col_n = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("N"))
            ls_col_o = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("O"))
            ls_col_p = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("P"))
            ls_col_q = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("Q"))
            ls_col_r = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("R"))
            ls_col_s = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("S"))
            ls_col_t = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("T"))
            ls_col_u = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("U"))
            ls_col_v = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("V"))
           'ls_col_w = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("W"))
            ls_col_w = f_LeftByBytes(adoStream, larr_report(ll_each_row, li_addr_col_start), 50) _
                     & f_LeftByBytes(adoStream, larr_report(ll_each_row, li_addr_col_start + 1), 50) _
                     & f_LeftByBytes(adoStream, larr_report(ll_each_row, li_addr_col_start + 2), 50) _
                     & f_LeftByBytes(adoStream, larr_report(ll_each_row, li_addr_col_start + 3), 50) _
                     & f_LeftByBytes(adoStream, larr_report(ll_each_row, li_addr_col_start + 4), 50)
            
            ls_col_x = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("X"))
            ls_col_y = larr_report(ll_each_row, (li_each_deposit * gi_rpt_col_num) + dict_col_indx("Y"))
            
            ls_each_record = ls_each_record & _
                             f_LeftByBytes(adoStream, ls_col_m, 100) & _
                             Left(ls_col_n & ls_spaces, 1) & _
                             Left(ls_col_o & ls_spaces, 1) & _
                             Left(ls_col_p & ls_spaces, 20) & _
                             f_date_rm_slash(ls_col_q) & _
                             Left(ls_col_r & ls_spaces, 20) & _
                             Left(ls_col_s & ls_spaces, 20) & _
                             Left(ls_col_t & ls_spaces, 100) & _
                             Left(ls_col_u & ls_spaces, 20) & _
                             Left(ls_col_v & ls_spaces, 20) & _
                             ls_col_w & _
                             Left(ls_col_x & ls_spaces, 20) & _
                             Left(ls_col_y & ls_spaces, 20)
        Next
        
        If ls_each_record = Empty Then
            ls_each_record = String(600, " ")   ' to append spaces
        End If

       'lo_output.WriteText RTrim(ls_each_record), adWriteLine
        lo_output.WriteText ls_each_record, adWriteLine
        'lo_output.WriteBlankLines (1)
    Next

    lo_output.WriteText Left("UBS" & ls_spaces, 10), adWriteLine

    lo_output.SaveToFile as_output_file, 2
    lo_output.Close
    
    Set lo_output = Nothing
    adoStream.Close
    Set adoStream = Nothing
End Sub



  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值