text_file_importer_vba

Option Explicit

' module level constants / variables
Const mcPathUpdateCell = "$C$2"
Const mcPathDisplayCell = "$B$2"
Const mcCtrlShName = "Control"
Const mcRowOffset = 4
Const mcMaxFiles = 10
Const mcHeadCol = "A"
Const mcFileCol = "B"
Const mcDelimCol = "C"
Const mcHeadsReqCol = "D"
Const mcColOffset = 5
Const mcListStartRow = 2


Private Sub Workbook_Open()
On Error GoTo Workbook_Open_err

    Const cProcName = "Workbook_Open"

    ActiveWorkbook.Sheets(mcCtrlShName).Select

    Call Gen.InitialiseGlobalVars

    ' store current path details in global variables
    gvPath = Range(mcPathUpdateCell).Value
    gvPathFormula = Range(mcPathDisplayCell).Formula

    Call GetFileLists


Workbook_Open_exit:
    Exit Sub

Workbook_Open_err:
    If gvErrNotes <> "Exit" Then
        Call Gen.ErrHandler(cProcName, Err.Number, Err.Description)
        If gvErrNotes <> "Exit" Then
            Resume Next
        End If
    End If

End Sub


Sub CheckPath()
On Error GoTo CheckPath_err

    Const cProcName = "CheckPath"

    gvPath = Range(mcPathUpdateCell).Value
    If gvPath = "" Then
        MsgBox ("A path is required in Cell " & mcPathDisplayCell & " for the " & _
                "automatic file locator to function correctly." & vbCrLf & vbCrLf & _
                "Please select a path using the ellipsis button and try again.")
        gvErrNotes = "Exit"
        Error (60001)
    End If


CheckPath_exit:
    Exit Sub

CheckPath_err:
    If gvErrNotes <> "Exit" Then
        Call Gen.ErrHandler(cProcName, Err.Number, Err.Description)
        If gvErrNotes <> "Exit" Then
            Resume Next
        End If
    End If

End Sub


Public Sub GetFileLists()
On Error GoTo GetFileLists_err

    ' local constants / variables
    Const cProcName = "GetFileLists"
    Dim vHeading As String
    Dim vRange As String
    Dim vListStartCell As String
    Dim vLastRow As Double
    Dim vListCol As String
    Dim vListColNo As Integer
    Dim vHeadRow As Integer
    Dim i As Integer

    MsgBox ("Finding KH4 output file names to refresh lists...")

    ' initialise variables
    gvErrNotes = Empty
    vHeading = Empty
    vRange = Empty
    vListStartCell = Empty
    vLastRow = 0
    vListCol = Empty
    vListColNo = 0
    vHeadRow = 0
    i = 0

    ' check if there a path to follow
    Call CheckPath

    ' loop through rows from A5 for mcMaxFiles to pick up each heading
    For i = 1 To mcMaxFiles
        vListColNo = mcColOffset + i
        vHeadRow = mcRowOffset + i
        vHeading = Range(mcHeadCol & vHeadRow).Value

        ' check if cell has a value before continuing
        If vHeading <> "" Then
            vListCol = Gen.ColNoToLetter(vListColNo)
            vListStartCell = vListCol & mcListStartRow

            ' set heading for file list in hidden cells
            Range(vListStartCell).Offset(-1, 0).Value = vHeading
            vLastRow = WorksheetFunction.Max(Gen.LastRow(mcCtrlShName, _
                vListStartCell), mcListStartRow) ' highest out of 2 or lastrow
            vRange = vListCol & mcListStartRow & ":" & vListCol & vLastRow

            ' unhide and clear old values
            Columns(vListCol).EntireColumn.Hidden = False
            Range(vRange).ClearContents

            ' get new file list for current heading
            Call Gen.PrintFileList(gvPath, True, vListStartCell, True, vHeading)

            ' sort list
            vLastRow = WorksheetFunction.Max(Gen.LastRow(mcCtrlShName, _
                vListStartCell), mcListStartRow)
            vRange = "$" & vListCol & "$" & mcListStartRow & ":$" & _
                vListCol & "$" & vLastRow
            Columns(vListCol).Sort key1:=Range(vRange), _
                order1:=xlDescending, Header:=xlNo

            ' get lists (for dropdowns on filenames) and default values
            With Range(mcFileCol & vHeadRow)
                .Value = Range(vListStartCell).Value ' sets default to first in list

                ' create validation list with dropdown
                With .validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, Formula1:="=" & vRange
                    .IgnoreBlank = True
                    .InCellDropdown = True
                End With
            End With

        ' hide column
        Columns(vListCol).EntireColumn.Hidden = True

        ' break loop if no heading in cell
        Else
            MsgBox ("No heading found on row " & vHeadRow & ", stopping loop." & _
                    vbCrLf & vbCrLf & (i - 1) & " lists updated.")
            Exit For

        End If

        ' next iteration through loop
        Next i

    Range(mcFileCol & (mcRowOffset + 1)).Select


GetFileLists_exit:
    Exit Sub

GetFileLists_err:
    If gvErrNotes <> "Exit" Then
        Call Gen.ErrHandler(cProcName, Err.Number, Err.Description)
        If gvErrNotes <> "Exit" Then
            Resume Next
        End If
    End If

End Sub


Public Sub ImportData()
On Error GoTo ImportData_err

    ' local constants / variables
    Const cProcName = "GetFileLists"
    Dim vBasePath As String
    Dim vHeadRow As Integer
    Dim vHeading As String
    Dim vPath As String
    Dim vDelim As String
    Dim vHeadsReq As String
    Dim vPasteFrom As String
    Dim i As Integer

    ' initialise variables
    gvErrNotes = Empty
    vBasePath = Empty
    vHeadRow = 0
    vHeading = Empty
    vPath = Empty
    vDelim = Empty
    vHeadsReq = Empty
    vPasteFrom = Empty
    i = 0

    ' check if there a path to follow
    Call CheckPath
    vBasePath = gvPath

    ' *** process to list and remove old sheets???

    ' loop through rows from A5 for mcMaxFiles to pick up each heading
    For i = 1 To mcMaxFiles
        ActiveWorkbook.Sheets(mcCtrlShName).Select
        vHeadRow = mcRowOffset + i
        vHeading = Range(mcHeadCol & vHeadRow).Value

        ' check if cell has a value before continuing
        If vHeading <> "" Then

            ' get full paths
            If Right(vBasePath, 1) <> "\" Then
                vBasePath = vBasePath & "\"
            End If
            vPath = vBasePath & Range(mcFileCol & vHeadRow).Value

            ' set file options
            vDelim = Range(mcDelimCol & vHeadRow).Value
            vHeadsReq = Range(mcHeadsReqCol & vHeadRow).Value
            vPasteFrom = IIf(vHeadsReq = "Yes", "$A$1", "$A$2")

            ' call data Import_Text_Data procedure
            Call Gen.Import_Text_Data(vHeading, vPath, vDelim, vPasteFrom)



        ' break loop if no heading in cell
        Else
            MsgBox ("No heading found on row " & vHeadRow & ", stopping loop." & _
                    vbCrLf & vbCrLf & (i - 1) & " files imported.")
            Exit For

        End If

        ' next iteration through loop
        Next i


ImportData_exit:
    Exit Sub

ImportData_err:
    If gvErrNotes <> "Exit" Then
        Call Gen.ErrHandler(cProcName, Err.Number, Err.Description)
        If gvErrNotes <> "Exit" Then
            Resume Next
        End If
    End If
End Sub


Public Sub CallGetFolder()
On Error GoTo CallGetFolder_err

    ' local constants / variables
    Const cProcName = "CallGetFolder"
    Dim vFolder As String
    Dim vStartFrom As String

    ' initialise variables
    gvErrNotes = Empty
    vFolder = Empty
    vStartFrom = Empty

    If Range(mcPathUpdateCell).Value = "" Then
        vStartFrom = Environ("UserProfile")
    Else
        vStartFrom = Range(mcPathUpdateCell).Value
    End If

    vFolder = Gen.GetFolder(vStartFrom) '"\\julie\logs\Keyhole"

    ' update if a value is returned
    If vFolder = "" Then
        Debug.Print "Not updating cell as no value returned"
    Else
        Range(mcPathUpdateCell).Value = vFolder
    End If

    ' check if formula is still where it should be - replace if not
    If Range(mcPathDisplayCell).Formula = "" Then
        Range(mcPathDisplayCell).Formula = _
            "=hyperlink(cell(""contents""," & mcPathUpdateCell & "), " & _
                       "cell(""contents""," & mcPathUpdateCell & "))"
        Range(mcPathDisplayCell).style = "lnk"
    ' Else: Refresh Formula
    Else
        Range(mcPathDisplayCell).Calculate
    End If

    ' store current path details in global variables
    gvPath = Range(mcPathUpdateCell).Value
    gvPathFormula = Range(mcPathDisplayCell).Formula


CallGetFolder_exit:
    Exit Sub

CallGetFolder_err:
    If gvErrNotes <> "Exit" Then
        Call Gen.ErrHandler(cProcName, Err.Number, Err.Description)
        If gvErrNotes <> "Exit" Then
            Resume Next
        End If
    End If
End Sub