excel vba : extract txt file

Module_sub_function.bas

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

Attribute VB_Name = "Module_sub_function"
Option Explicit

Public Const gs_toolbar_name = "Often2"
Public gs_format_sheet As String
Public gs_sheet_file_parsed As String
Public gs_header_tag As String
Public gs_trailor_tag As String

Public gs_autofit_tag As String

Global gs_default_path As String

Public gl_xls_max_row_no As Long
Public gl_xls_max_col_no As Long
'Public Const gl_xls_max_row_no = Columns(1).Rows.Count
'Public Const gl_xls_max_col_no = Rows(1).Columns.Count

'-------------------------------------
Public g_saved_font As Font
'Public g_saved_fillformat As FillFormat
Public g_saved_interior As Interior
Public g_saved_border As Borders
'-------------------------------------


Sub auto_open()

    'gl_xls_max_row_no = Columns(1).Rows.Count
    'gl_xls_max_col_no = Rows(1).Columns.Count
    
    'MsgBox gl_xls_max_row_no & "--" & gl_xls_max_col_no
    
    'sub_setbar
End Sub

Sub sub_setbar()
    Dim lbar_cmd As CommandBar
    Dim lbtn_cpi As CommandBarButton
    Dim lbtn_cpi_charge As CommandBarButton
    Dim lbtn_overwrite_col_width As CommandBarButton
    Dim lbtn_temp As CommandBarButton
    
    
    Dim i As Integer, j As Integer
    Dim blnTestLogo As Boolean
    
    sub_RemovePreviousBar
    
    Set lbar_cmd = Application.CommandBars.Add(gs_toolbar_name, msoBarTop)
    lbar_cmd.Visible = True
 
    '   Impt_IBMCA_Feed
    With lbar_cmd.Controls.Add(msoControlButton)
        .Caption = "Load IBM CA feed file"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_Impt_IBMCA_Feed"
        .TooltipText = "Load the IBM CA feed file automatically"
        .FaceId = 23
    End With

    Set lbtn_cpi = lbar_cmd.Controls.Add(msoControlButton)
    With lbtn_cpi
        .Caption = "Import CPI file"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_import_cpi"
        .TooltipText = "Load the CPI file"
        .FaceId = 23
        '.Enabled = False
    End With

    Set lbtn_cpi_charge = lbar_cmd.Controls.Add(msoControlButton)
    With lbtn_cpi_charge
        .Caption = "Import CPI charge file"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_import_cpi_charge"
        .TooltipText = "Load the CPI charge file"
        .FaceId = 23
        '.Enabled = False
    End With
    
    Set lbtn_overwrite_col_width = lbar_cmd.Controls.Add(msoControlButton)
    With lbtn_overwrite_col_width
        .Caption = "SetBack_ColumnWidth"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_overwrite_column_width"
        .TooltipText = "sub_overwrite_column_width"
        .FaceId = 23
        '.Enabled = False
    End With

    Set lbtn_temp = lbar_cmd.Controls.Add(msoControlButton)
    With lbtn_temp
        .Caption = "For test"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_for_test"
        .TooltipText = "sub_for_test"
        .FaceId = 23
        '.Enabled = False
    End With
    
    '   Exit
    With lbar_cmd.Controls.Add(msoControlButton)
        .Caption = "Remove this toolbar"
        .Style = msoButtonIconAndCaptionBelow
        .OnAction = "sub_RemovePreviousBar"
        .FaceId = 722
        .TooltipText = "Close this tool"
        .BeginGroup = True
    End With
End Sub

Private Sub sub_RemovePreviousBar()
    On Error Resume Next
    Application.CommandBars(gs_toolbar_name).Delete
End Sub

Public Sub sub_Impt_IBMCA_Feed()
    'Application.DefaultFilePath = "D:\00.Workout\Task_output\UT\Data_Link\After_change"
    If Trim(gs_default_path) = "" Then
        gs_default_path = "D:\00.Workout\Task_output\UT\Data_Link\After_change"
    End If
    
    gs_format_sheet = "IBM_CA_format"
    
    gs_sheet_file_parsed = "temp_IBMCA_feed"
    
    gs_header_tag = "HEADER"  ' if the line is the 1st line, header line, then ignore it.
    gs_trailor_tag = "TRAILE" ' if the line is the last line, trailor line, then ignore it.
    
    Call sub_parse_file
End Sub


Public Sub sub_import_cpi()
    'Application.DefaultFilePath = "D:\iSpace\Documents\Business_Doc\RichardDeng_dont_delete\ISPACE_AUTOMATION\ISPACE_AUTOMATION\FILES_AUTOMATION"
    
    If Trim(gs_default_path) = "" Then
        gs_default_path = "D:\iSpace\Documents\Business_Doc\RichardDeng_dont_delete\ISPACE_AUTOMATION\ISPACE_AUTOMATION\FILES_AUTOMATION"
        'gs_default_path = "D:\00.Workout\Task_output\UT\CPI"
    End If
        
    gs_format_sheet = "CPI_format"
    gs_sheet_file_parsed = "temp_cpi_feed"
    
    gs_header_tag = "HEAD"  ' if the line is the 1st line, header line, then ignore it.
    gs_trailor_tag = "TAIL" ' if the line is the last line, trailor line, then ignore it.
    
    Call sub_parse_file
End Sub


Public Sub sub_import_cpi_charge()
    'Application.DefaultFilePath = "D:\iSpace\Documents\Business_Doc\RichardDeng_dont_delete\ISPACE_AUTOMATION\ISPACE_AUTOMATION\FILES_AUTOMATION"
    
    If Trim(gs_default_path) = "" Then
        gs_default_path = "D:\iSpace\Documents\Business_Doc\RichardDeng_dont_delete\ISPACE_AUTOMATION\ISPACE_AUTOMATION\FILES_AUTOMATION"
    End If
    
    gs_format_sheet = "CPI_charge_format"
    gs_sheet_file_parsed = "temp_cpi_chr_feed"
    
    gs_header_tag = "HEAD"  ' if the line is the 1st line, header line, then ignore it.
    gs_trailor_tag = "TAIL" ' if the line is the last line, trailor line, then ignore it.
    
    gs_autofit_tag = "N"
    
    Call sub_parse_file
End Sub

Public Sub sub_parse_file()
    Dim ls_feed_file As String
    Dim ll_line_cnt As Long
    Dim ls_each_line As String
    Dim ll_max_row_no As Long
    Dim li_row_no_tmp As Integer
    Dim li_new_sheet_col_no As Integer
    
    Dim li_start_pos As Integer
    Dim li_end_pos As Integer
    Dim ls_each_column As String
    Dim ls_last_sheet As String
    
    Dim li_seprator_column As Integer
    Dim li_col_no As Long
    Dim sheet_tmp As Worksheet
    
    Dim Response As String
    Dim ls_drive As String
    
    'Dim fso, ts
    Dim fso As Object, ts As Object
    
    gl_xls_max_row_no = Columns(1).Rows.Count
    gl_xls_max_col_no = Rows(1).Columns.Count

    On Error Resume Next
    
    ' activeworkbook.Worksheets(gs_format_sheet)
    
    Set sheet_tmp = ActiveWorkbook.Worksheets.Item(gs_format_sheet)
    
    If sheet_tmp Is Nothing Then
        Response = MsgBox("There's no sheet named " + gs_format_sheet + "!" _
        + Chr(10) + Chr(13) _
        + Chr(10) + Chr(13) _
        + "Please open the correct workbook first! ", _
        vbOKOnly + vbExclamation, "Caution")
        Exit Sub
    End If
    
    ls_drive = Mid(Trim(gs_default_path), 1, 1) 'e.g. drive D
    ChDrive ls_drive
    ChDir gs_default_path   ' change to the specified path first

    ls_feed_file = Application.GetOpenFilename("All files (*.*), *.*", 0, "select file", , False)
        
    If Trim(ls_feed_file) = "" Or Trim(ls_feed_file) = "False" Then
        Exit Sub
    End If
    
    gs_default_path = Mid(ls_feed_file, 1, Len(ls_feed_file) - Len(Dir(ls_feed_file)))
    
    'Application.DefaultFilePath = "C:\"

    'll_max_row_no = Sheets(gs_format_sheet).Range("B1000").End(xlUp).Row
    ll_max_row_no = Sheets(gs_format_sheet).Cells(gl_xls_max_row_no, "B").End(xlUp).Row
    
    ll_line_cnt = 0
    
    ' delete the existing temp sheet first
    Dim Sh As Worksheet
    For Each Sh In Sheets
        If Sh.Name = gs_sheet_file_parsed Then
            Application.DisplayAlerts = False
            Sheets(gs_sheet_file_parsed).Delete
        End If
    Next

    ' add a new sheet for feed file display
    Sheets.Add.Name = gs_sheet_file_parsed
    
    Sheets(gs_sheet_file_parsed).Select
    Sheets(gs_sheet_file_parsed).Move After:=Sheets(Sheets.Count)
    
    Sheets(gs_sheet_file_parsed).Cells.Select
    Selection.NumberFormat = "@"
    
    li_seprator_column = 0
    
    ' load feed file each column by each column
    With Sheets(gs_sheet_file_parsed)
        .Cells.ClearContents
                
        li_new_sheet_col_no = 1
        For li_row_no_tmp = 2 To ll_max_row_no
            With Sheets(gs_sheet_file_parsed)
                .Cells(1, li_new_sheet_col_no).Value = Sheets(gs_format_sheet).Cells(li_row_no_tmp, 1).Value
                .Cells(2, li_new_sheet_col_no).Value = Sheets(gs_format_sheet).Cells(li_row_no_tmp, 2).Value
            End With
            
            li_new_sheet_col_no = li_new_sheet_col_no + 1
        Next
                
        'Set fso = CreateObject("Scripting.FileSystemObject")
        Set fso = New Scripting.FileSystemObject
        Set ts = fso.OpenTextFile(Filename:=ls_feed_file, IOMode:=ForReading, Create:=False)

        Do While Not ts.AtEndOfStream
            'ls_each_line = ts.ReadLine & NewLine
            ls_each_line = ts.ReadLine
            
            ' if each line is not "HEADER" or "TRAILOR", parse it
            'If Mid(ls_each_line, 1, 6) <> gs_header_tag And Mid(ls_each_line, 1, 6) <> gs_trailor_tag Then
            If Not (InStr(Mid(ls_each_line, 1, 8), gs_header_tag) = 1 Or InStr(Mid(ls_each_line, 1, 8), gs_trailor_tag) = 1) Then
                ll_line_cnt = ll_line_cnt + 1
                For li_row_no_tmp = 2 To ll_max_row_no
                    li_start_pos = Sheets(gs_format_sheet).Cells(li_row_no_tmp, 3).Value
                    li_end_pos = Sheets(gs_format_sheet).Cells(li_row_no_tmp, 4).Value
                    
                    li_col_no = li_row_no_tmp - 1
                    
                    If li_start_pos <> 0 Then
                        ls_each_column = Mid(ls_each_line, li_start_pos, li_end_pos - li_start_pos + 1)
                        
                        Sheets(gs_sheet_file_parsed).Cells(ll_line_cnt + 2, li_col_no).Value = ls_each_column
                    Else
                        ' the start position is 0, so this a blank column, set it be shown in gray
                        li_seprator_column = li_col_no
                        Sheets(gs_sheet_file_parsed).Cells(1, li_col_no).Value = Null
                        Sheets(gs_sheet_file_parsed).Cells(2, li_col_no).Value = Null
                        Sheets(gs_sheet_file_parsed).Cells(ll_line_cnt + 2, li_col_no).Value = Null
                    End If
                Next
            End If
        Loop
                
        Set fso = Nothing
        Set ts = Nothing
        
        ts.Close
        fso.Close
        
    End With

    ' set the first 2 lines wrap text
    Range(Cells(1, 1), Cells(2, ll_max_row_no - 1)).Select
    Selection.Font.Bold = True
    Selection.WrapText = True
    
    Selection.Borders(xlEdgeLeft).Weight = xlThin
    Selection.Borders(xlEdgeTop).Weight = xlThin
    Selection.Borders(xlEdgeBottom).Weight = xlThin
    Selection.Borders(xlEdgeRight).Weight = xlThin
    Selection.Borders(xlInsideVertical).Weight = xlThin
    Selection.Borders(xlInsideHorizontal).Weight = xlThin
    Selection.Interior.ThemeColor = xlThemeColorAccent6
    Selection.Interior.TintAndShade = 0.399975585192419
    
    ' set the data part, the lines following the first 2 lines
    Range(Cells(3, 1), Cells(ll_line_cnt + 2, ll_max_row_no - 1)).Select
    Selection.Font.Bold = False
    Selection.WrapText = False
    
    Selection.Borders(xlEdgeLeft).Weight = xlThin
    Selection.Borders(xlEdgeTop).Weight = xlThin
    Selection.Borders(xlEdgeBottom).Weight = xlThin
    Selection.Borders(xlEdgeRight).Weight = xlThin
    Selection.Borders(xlInsideVertical).Weight = xlThin
    Selection.Borders(xlInsideHorizontal).Weight = xlThin
    
    'If li_seprator_column = 0 Then
    '    MsgBox ("Please convert the feed file from UNIX to DOS first!")
    '    Exit Sub
    'End If
    
    ' if there's a seperator column, set it be gray
    If li_seprator_column > 0 Then
        Sheets(gs_sheet_file_parsed).Columns(li_seprator_column).Select
        
        Sheets(gs_sheet_file_parsed).Range(Cells(1, li_seprator_column), Cells(ll_line_cnt + 2, li_seprator_column)).Select
        
        Selection.Interior.ThemeColor = xlThemeColorLight1
        Selection.Interior.TintAndShade = 0.249977111117893
    End If
    
    ' set the column width
    If gs_autofit_tag = "Y" Then
        Sheets(gs_sheet_file_parsed).Cells.Select
        Sheets(gs_sheet_file_parsed).Cells.EntireColumn.AutoFit
    Else
        li_new_sheet_col_no = 1
        For li_row_no_tmp = 2 To ll_max_row_no
            Sheets(gs_sheet_file_parsed).Columns(li_new_sheet_col_no).ColumnWidth = Sheets(gs_format_sheet).Cells(li_row_no_tmp, "F").Value
            
            li_new_sheet_col_no = li_new_sheet_col_no + 1
        Next
    End If
    
    ' fraze pannel
    Rows("3:3").Select
    ActiveWindow.FreezePanes = True
    
    Rows.EntireRow.AutoFit
    
    ActiveWindow.DisplayGridlines = False
    
    Sheets(gs_sheet_file_parsed).Range("A1").Select
End Sub

Sub sub_overwrite_column_width()
    Dim ls_response As String
    Dim each_column As Range
    Dim ll_col_no_selected As Long
    Dim ls_active_sheet As String
    Dim ls_format_sheet As String
    
    Dim ls_target_sheet As String
    Dim ls_target_sheet_tmp As String
    
    On Error Resume Next
    
    gl_xls_max_row_no = Columns(1).Rows.Count
    gl_xls_max_col_no = Rows(1).Columns.Count
    
    If Selection.Address <> Selection.EntireColumn.Address Then
        ls_response = MsgBox("Please select whole column(s) first!", vbExclamation + vbOKOnly, "Caution")
        Exit Sub
    End If
    
    ls_active_sheet = ActiveWorkbook.ActiveSheet.Name
    
    If ls_active_sheet = "temp_cpi_chr_feed" Then
        ls_target_sheet = "CPI_Charge_format"
    End If
    If ls_active_sheet = "temp_cpi_feed" Then
        ls_target_sheet = "CPI_format"
    End If
    If ls_active_sheet = "temp_IBMCA_feed" Then
        ls_target_sheet = "IBM_CA_format"
    End If
    
    If Trim(ls_target_sheet) = "" Then
        ls_response = MsgBox("Please open the correct workbook (IBM_CA_format, CPI_Charge_format,CPI_format) first!", _
        vbExclamation + vbOKOnly, "Caution")
        Exit Sub
    End If
    
    ls_target_sheet_tmp = Sheets(ls_target_sheet).Name

    If Trim(ls_target_sheet_tmp) = "" Then
        ls_response = MsgBox("The sheet " & ls_target_sheet & " hardcoded in sub_overwrite_column_width does not exist, " & _
        "you have to check & change the sheet name!", vbExclamation + vbOKOnly, "Caution")
        Exit Sub
    End If
    
    ls_response = MsgBox("Are you sure to overwrite the sheet " & ls_target_sheet & "?", vbExclamation + vbYesNoCancel, _
                         "Be careful")
    If ls_response <> vbYes Then
        Exit Sub
    End If
    
    Dim ll_column_cnt As Long
    Dim lrng_actual_selection As Range
    
    Set lrng_actual_selection = Selection
    
    ll_column_cnt = Selection.Columns.Count
    
    If ll_column_cnt = gl_xls_max_col_no Then
        ll_column_cnt = Cells(1, gl_xls_max_col_no).End(xlToLeft).Column
        
        Set lrng_actual_selection = Range(Columns(1), Columns(ll_column_cnt))
    End If
        
       ' Cells(1, gl_xls_max_col_no).End(xlLeft).Select
        'MsgBox ll_column_cnt
        
       'Exit Sub
    
    For Each each_column In lrng_actual_selection.Columns
    'For ll_each_col = 1 To ll_column_cnt
        ll_col_no_selected = each_column.Column  'the column no you selected
        
        Sheets(ls_target_sheet).Cells(ll_col_no_selected + 1, "F") = each_column.ColumnWidth
    Next
End Sub



Sub sub_for_test()
    Range(Columns(1), Columns(1)).Select
    Range("B:b").Select
    
    Exit Sub
    Dim lfnt_font As Font
    Dim lbdr_border As Border
    Dim l_fillcolor As FillFormat

    Dim lcell_cell As CellFormat
    
    Dim lfmt_origin_fmt As CellFormat
    
    Call sub_get_format(ActiveCell)
    
    Call sub_setback_format(Range("b1:c10"))
    
    
    Set lfnt_font = ActiveCell.Font
    'Set lbdr_border = ActiveCell.Borders.
    
    
    'Set lfmt_origin_fmt = ActiveCell.DisplayFormat
    
    'Set Range("B1:C9").DisplayFormat = lfmt_origin_fmt

    Range("B1:C9").Font.Color = lfnt_font.Color



   Exit Sub
   
    ' Set the interior of cell A1 to yellow.
    Range("A1:B5").Select
    Selection.Interior.ColorIndex = 36
    MsgBox "The cell format for cell A1 is a yellow interior."

    ' Set the CellFormat object to replace yellow with green.
    With Application
        .FindFormat.Interior.ColorIndex = 36
        .ReplaceFormat.Interior.ColorIndex = 35
    End With

    ' Find and replace cell A1's yellow interior with green.
    Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
        ReplaceFormat:=True
    MsgBox "The cell format for cell A1 is replaced with a green interior."

End Sub


Sub sub_get_format(arng_range As Range)
    Set g_saved_font = arng_range.Font
    Set g_saved_interior = arng_range.Interior
    
    Set g_saved_border = arng_range.Borders
    
        
End Sub


Sub sub_setback_format(arng_range As Range)
    With arng_range.Font
        .Color = g_saved_font.Color
        .Size = g_saved_font.Size
        .Strikethrough = g_saved_font.Strikethrough
        .Underline = g_saved_font.Underline
        .Bold = g_saved_font.Bold
        .ColorIndex = g_saved_font.ColorIndex
        .FontStyle = g_saved_font.FontStyle
    End With
     
    With arng_range.Borders
    
        .Color = g_saved_border.Color
    End With
        
    With arng_range.Interior
        .Color = g_saved_interior.Color
        
    End With
End Sub
 

ThisWorkbook.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ThisWorkbook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

Private Sub Workbook_Activate()
    Dim lcb_commdbar As CommandBar
    
    On Error GoTo Error_exit
    
    Set lcb_commdbar = Application.CommandBars("toolbar_feedfile_extract")
    lcb_commdbar.Visible = True
    
Error_exit:
    Set lcb_commdbar = Nothing
End Sub

Private Sub Workbook_Deactivate()
    Dim lcb_commdbar As CommandBar
    
    On Error GoTo Error_exit
    
    Set lcb_commdbar = Application.CommandBars("toolbar_feedfile_extract")
    lcb_commdbar.Visible = False
    
Error_exit:
    
    Set lcb_commdbar = Nothing
    
End Sub

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


Private Sub Workbook_Open()
    
    'gs_freeze_screen = "TOP"
    
    'gl_MaxRow_ofExcel = ThisWorkbook.Sheets(1).Columns(1).Rows.Count
    'gl_MaxCol_ofExcel = ThisWorkbook.Sheets(1).Rows(1).Columns.Count
   
    Call sub_RemoveToolBar("toolbar_feedfile_extract")
    'Call sub_remove_all_bars
    
    '============================================================================================
    Call sub_add_new_bar("toolbar_feedfile_extract")
    Call sub_add_new_button(as_bar_name:="toolbar_feedfile_extract", as_btn_caption:="Import feed file to divide", _
                    as_on_action:="sub_import_cpi", ai_face_id:=300, _
                    as_tip_text:="Divide file")

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