Attribute VB_Name = "Module1"
Option Compare Text
' status of first startup
Public FirstRun As Boolean
' parameter for user-form route selection
Public MasterRoute As String
' security flag for sheet modification
Public CanEdit As Boolean
' filename parameter for opening/writing files
Public myFile As String
' anchor for file dialog browser
Public Browsed As String
' file count from directory search
Public Fcount As Integer
Public Bypasser As Boolean
' ordinal count of tasks supplied to conduit
Public OrdCount As Long
' absolute directory location for Conduit
Public AbsLoc As String
' absolute directory location for all Connector transaction
Public GbsLoc As String
' multi-purpose parameter, file info, raw data
Public textline As String
' a region saved in the machine/program/process naming as csv
Public WorkArea As String
Public WorkBrea As String
' a region saved in the machine/program/process naming as csv
Public WorkCrea As String
Public WorkDrea As String
' a region saved in the machine/program/process naming as csv
Public WorkErea As String
Public WorkFrea As String
' current mode of user form interaction
Public Uformed As String
' has already been analyzed
Public Alyzed As Boolean
' screen width and height reported by Conduit
Public Swidth As Integer
Public Sheight As Integer
' indication if Fire and Conduit in control
Public Fired As Boolean
' operate mail system via Outlook
Public Mails As Boolean
' email account name receve/send
Public MailAcct As String
' folder within mail account receiving filtered emails
Public MailFold As String
' conduit folder name for mail text
Public MailDest As String
' full path for mail text
Public MailArea As String
' recipient for email send test
Public TestRecip As String
' incrementing message ordinal
Public MsgOrdinal As Integer
' folder within conduit for Fire communication
Public Nexus As String
Public cUnique As New Collection
Public horiz As Boolean
Public uList() As Variant
Dim Shower As Boolean
Public MsgCnt As Integer
Dim cm As Variant
Dim cmval As Variant
Dim clval As Variant
Public RawIndex As Integer
Public RawOrd As Integer
Public RawEndRow As Integer
Public RawName As String
Public RawRange As Range
Public RawHdrR As Integer
Public RawHdrC As Integer
Public RawFields As Integer
Public PhoneHdrR As Integer
Public PhoneHdrC As Integer
Public PhoneFields As Integer
Public PhoneBase As Range
Public PhoneEndRow As Integer
Public WorkName As String
Public WorkOrd As Integer
Public WorkHdrR As Integer
Public WorkHdrC As Integer
Public WorkFields As Integer
Public WorkBase As Range
Public WorkRange As Range
Public WorkIndex As Integer
Public ScreenRes As Integer
Public PixPnt As Single
Public EndRdate As Date
Public CurSels As Integer
Public PageRows As Integer
Public PageMark As Integer
Public PageCount As Integer
Public Paging As Boolean
Public CurrentPage As Integer
Public TotalPages As Integer
Public HoldOff As Boolean
Public PhonesChanging As Boolean
Public Exiting As Boolean

Public Sub ExportAllVbaModules()
    Dim p As String
    p = "C:\___Work\MackServe_VBA_Export\"
    If Dir(p, vbDirectory) = "" Then MkDir p

    Dim vbComp As Object
    For Each vbComp In ThisWorkbook.VBProject.VBComponents
        Select Case vbComp.Type
            Case 1 ' Std module
                vbComp.Export p & vbComp.Name & ".bas"
            Case 2 ' Class module
                vbComp.Export p & vbComp.Name & ".cls"
            Case 3 ' UserForm
                vbComp.Export p & vbComp.Name & ".frm"
            Case 100 ' Document (Sheet/ThisWorkbook)
                vbComp.Export p & vbComp.Name & ".cls"
        End Select
    Next vbComp

    MsgBox "Exported VBA modules to: " & p, vbInformation
End Sub

Public Function CkMail() As Boolean
    BackServe.MailIncoming MailFold, "", AbsLoc & MailDest
    CkMail = True
End Function

Public Function OutMail(ByVal recip As String, ByVal subj As String, ByVal bodyr As String) As Boolean
    BackServe.SendEmail recip, subj, bodyr
    OutMail = True
End Function

Public Function UnHold() As Boolean
    HoldOff = False
    BackServe.CollectPhones
    BackServe.ReSeat
    UnHold = True
End Function

Public Function ReShow() As Boolean
    If HoldOff Then
    Else
        BackServe.ShowWork
    End If
    ReShow = True
End Function

Public Function CleanDate(ByVal datr As String) As Date
Dim sdat As Date
    On Error Resume Next
    sdat = Date
    sdat = CDate(datr)
    On Error GoTo 0
    CleanDate = sdat
End Function

Public Sub ProcessCheckBox()
    Dim cb As CheckBox
    Dim crng As Range
    With ActiveSheet
        Set cb = .CheckBoxes(Application.Caller)
        If Not cb Is Nothing Then
            Set crng = ActiveSheet.Range(cb.LinkedCell)
            If cb.value = 1 Then
                crng.value = "      " & vbCrLf & "      "
                crng.Style = "Good"
                CurSels = CurSels + 1
            Else
                crng.value = "      " & vbCrLf & "      "
                crng.Style = "Normal"
                CurSels = CurSels - 1
            End If
        Else
        End If
    End With
    BackServe.UpdSels
End Sub
Public Sub UncheckAct(ByVal rngs As String)
    Dim crng As Range
    Dim cb As CheckBox
    With ActiveSheet
        For Each cb In .CheckBoxes
            If cb.LinkedCell = rngs Then
                cb.value = 0
                Set crng = ActiveSheet.Range(cb.LinkedCell)
                crng.value = "      " & vbCrLf & "      "
                crng.Style = "Normal"
            End If
        Next
    End With
End Sub
Public Sub CheckAct(ByVal rngs As String)
    Dim crng As Range
    Dim cb As CheckBox
    With ActiveSheet
        For Each cb In .CheckBoxes
            If cb.LinkedCell = rngs Then
                cb.value = 1
                Set crng = ActiveSheet.Range(cb.LinkedCell)
                crng.value = "      " & vbCrLf & "      "
                crng.Style = "Good"
            End If
        Next
    End With
End Sub
Public Sub OfRaw(ByVal rawrw As Integer)
        Set RawRange = Sheets("Raw").Range(RcRange(rawrw, RawHdrC))
End Sub
Public Function Rawned(ByVal rawn As String) As String
Dim wrkr As Range
    NamedRaw rawn
    If RawOrd = 0 Then
        Rawned = ""
    Else
        Set wrkr = RawRange.Offset(0, RawOrd - 1)
        Rawned = CStr(wrkr.Cells(1, 1))
    End If
End Function
Public Function RawNameData(ByVal rawrw As Integer, ByVal rawn As String) As String
Dim wrkr As Range
    NamedRaw rawn
    If RawOrd = 0 Then
        RawNameData = ""
    Else
        OfRaw rawrw
        Set wrkr = RawRange.Offset(0, RawOrd - 1)
        RawNameData = CStr(wrkr.Cells(1, 1))
    End If
End Function
Public Function RcRange(rowref, colref) As String
    RcRange = Chr(Asc("A") + colref - 1) & CStr(rowref)
End Function
Public Sub Clearun()
Dim i As Long
    For i = cUnique.Count To 1 Step -1
        cUnique.Remove i
    Next i
End Sub
Private Function Listun() As Variant
Dim i As Long
ReDim uList(1 To 1)
uList(1) = "-"
If cUnique.Count > 0 Then
    'Resizing the array size
    ReDim uList(1 To cUnique.Count)
    'Inserting values from collection to array
    For i = 1 To cUnique.Count
        uList(i) = cUnique(i)
    Next i
    If Not horiz Then
        uList = Application.WorksheetFunction.Transpose(uList)
    End If
End If
    If Not Shower And UBound(uList) = 1 Then
        i = i + 1
    End If
    Listun = uList
End Function

Public Function UniqueItemList(InputRange As Range) As Variant
Dim cl As Range
Clearun
For Each cl In InputRange
    clval = cl.value
    If clval = "" Then clval = "-"
    'Adding values in collection
    On Error Resume Next
    cUnique.Add clval, CStr(clval)
    On Error GoTo 0
Next cl
'Initializing value Exit Sub by the function
UniqueItemList = Listun
End Function

Public Function PreForm() As Boolean
    BackServe.Continuing
    PreForm = True
End Function

Public Function SaveBook() As Boolean
    If Application.ActiveWorkbook.Saved Then
    Else
        BackServe.Saving
        Application.DisplayAlerts = False
    End If
    SaveBook = True
End Function

Public Function Minimize() As Boolean
    BackServe.AppMin
    Minimize = True
End Function

Public Function Maximize() As Boolean
    BackServe.AppMax
    Maximize = True
End Function

Public Sub BaseSizing(ByVal szngw As String, ByVal szngh As String)
    Swidth = CInt(szngw)
    Sheight = CInt(szngh)
    Fired = True
    ' Uformed = "Tiny"
    ' BackServe.AnLayout
End Sub
Sub PlaceImage(rng As Range, pic As String)
    Dim p As Picture
    Set p = rng.Worksheet.Pictures.Insert(pic)
    With p
        .Left = rng.Left - p.Width
        .Top = rng.Top
        .Placement = 1
    End With
End Sub
Public Function FitPic(ByVal rng As Range, pic As String, ByVal rw As Integer, ByVal rh As Integer) As Boolean
    FitPic = True
    On Error GoTo NOT_SHAPE
    Dim PicWtoHRatio As Single
    Dim CellWtoHRatio As Single
    CellWtoHRatio = rw / rh
    Dim p As Picture
    Set p = rng.Worksheet.Pictures.Insert(pic)
    With p
        .Left = rng.Left ' - p.Width
        .Top = rng.Top
        .Placement = 1
        .ShapeRange.LockAspectRatio = True
        PicWtoHRatio = .Width / .Height
        Select Case PicWtoHRatio / CellWtoHRatio
            Case Is > 1
                .Height = rw / PicWtoHRatio
            Case Else
                .Width = rh * PicWtoHRatio
        End Select
    End With
    Exit Function
NOT_SHAPE:
    FitPic = False
End Function
Public Function NextOpenRange(ByVal shtr As String, ByVal rowref As Integer, ByVal colref As Integer, _
                                        ByVal seekr As Integer) As Range
Dim actrow As Long
Dim actrng As Range
Dim bctrng As Range
Dim cctrng As Range
Dim dctrng As Range
Dim idxer As Integer
    actrow = Sheets(shtr).Rows.Count
    ' assumed to be on the header row with each heading cell having some text
    ' seeks from the maximum raw row upwards using the column specified
    Set actrng = Sheets(shtr).Cells(actrow, colref + seekr).End(xlUp).Offset(1, -seekr)
    ' make sure there is not some blank content in that end row
    Do While Len(Trim(actrng.Offset(-1, seekr))) = 0
        Set actrng = actrng.Offset(-1, 0)
    Loop
    ' gets the rightmost column of heading
    Set bctrng = Sheets(shtr).Cells(rowref, colref).End(xlToRight)
    ' gets the open row and focus on the column
    Set cctrng = Sheets(shtr).Cells(actrng.Row, colref)
    ' the open row range is extended to the header last column
    Set dctrng = cctrng.Resize(, bctrng.Column - colref + 1)
    Set NextOpenRange = dctrng
End Function
'
' file handling utilities
'
Public Function ReadLine() As Boolean
    ReadLine = False
    textline = ""
    myFile = Replace(myFile, "_.", ".")
    On Error Resume Next
    Open myFile For Input As #1
    Line Input #1, textline
    Close #1
    On Error GoTo 0
    If Len(textline) > 2 Then
        textline = Mid(textline, 2, Len(textline) - 2)
        ReadLine = True
    End If
End Function
Public Sub ReadFile()
    Dim strer As String
    textline = ""
    myFile = Replace(myFile, "_.", ".")
    On Error Resume Next
    Open myFile For Input As #1
    Do Until EOF(1)
        Line Input #1, strer
        textline = textline & strer
    Loop
    Close #1
    On Error GoTo 0
End Sub
Public Sub ReadBile()
    Dim strer As String
    Dim chrer As Byte
    textline = ""
    myFile = Replace(myFile, "_.", ".")
    On Error GoTo endbile
    Open myFile For Binary Lock Read As #1
    Do Until EOF(1)
        Get #1, , chrer
        textline = textline & Chr(chrer)
    Loop
endbile:
    On Error GoTo 0
    On Error GoTo fndbile
    Close #1
fndbile:
    On Error GoTo 0
End Sub
Public Sub WriteBile()
    Dim strer As String
    Dim chrer As Byte
    Dim idxer As Integer
    myFile = Replace(myFile, "_.", ".")
    On Error Resume Next
    Open myFile For Output As #1: Close #1
    Open myFile For Binary Lock Write As #1
    For idxer = 1 To Len(textline)
        chrer = Asc(Mid(textline, idxer, 1))
        If chrer = 0 Then
            Exit For
        End If
        Put #1, , chrer
    Next
    Close #1
    On Error GoTo 0
End Sub
Public Function WriteFire(ByVal vect As String) As Long
Dim nxord As String
Dim retlng As Long
    retlng = NextOrd()
    nxord = CStr(retlng)
    textline = "<" & vect & " ord=""" & nxord & """ >" & "</" & vect & ">"
    myFile = GbsLoc & "cndV_" & nxord & "_" & vect & ".txt"
    WriteFile
    WriteFire = retlng
End Function
Public Function NextOrd() As Long
    OrdCount = OrdCount + 1
    NextOrd = OrdCount
End Function
Public Function WriteFirf(ByVal vect As String, ByVal Firex As String) As Long
Dim nxord As String
Dim retlng As Long
    retlng = NextOrd()
    nxord = CStr(retlng)
    textline = "<" & vect & " ord=""" & nxord & """ " _
                        & "value=""" & Firex & """ >" & "</" & vect & ">"
    myFile = GbsLoc & "cndV_" & nxord & "_" & vect & ".txt"
    WriteFile
    WriteFirf = retlng
End Function
Public Sub WriteFile()
    myFile = Replace(myFile, "_.", ".")
    On Error Resume Next
    Open myFile For Output As #1
    Write #1, textline
    Close #1
    On Error GoTo 0
End Sub
'
' save a region into a data stream for later retrieval
'
Public Sub SaveCsv(ByVal shtr As String, ByVal arear As String)
    textline = ""
    On Error Resume Next
    ' create the csv string
    For Each m In Application.Sheets(shtr).Range(arear)
        If Len(m) = 0 Then
            textline = textline & ","
        Else
            textline = textline & """" & m & ""","
        End If
    Next
    On Error GoTo 0
End Sub
Public Function AssignCell(ByVal m As Object, ByVal idxer As Integer) As Integer
    ' Dim idxer As Integer
    Dim chrer As Byte
    Dim qter As Boolean
    Dim qtpn As Integer
    Dim contr As String
        qter = False
        contr = ""
        Do While idxer <= Len(textline)
            chrer = Asc(Mid(textline, idxer, 1))
            If qter Then
                If chrer = &H22 Then
                    If (idxer - qtpn) > 1 Then
                        contr = Mid(textline, qtpn + 1, idxer - qtpn - 1)
                    Else
                        contr = ""
                    End If
                    qter = False
                Else
                End If
            Else
                If chrer = &H22 Then
                    qter = True
                    qtpn = idxer
                Else
                    If chrer = &H2C Then
                        m.value = contr
                        contr = ""
                        idxer = idxer + 1
                        Exit Do
                    Else
                        
                    End If
                    
                End If
            End If
            idxer = idxer + 1
        Loop
        ' If idxer > Len(textline) Then Exit For
        AssignCell = idxer
End Function
Public Function RestoreApp()
    Application.WindowState = xlNormal
    RestoreApp = True
End Function
Public Function HereCheck() As Boolean
    HereCheck = True
End Function
Public Function EndXl() As Boolean
    BackServe.EndApp
    EndXl = True
End Function
Public Sub AppendMsg(ByVal wrkfile As String)
Dim wrkr As Range
    Set wrkr = NextOpenRange("Raw", RawHdrR, RawHdrC, 6)
    On Error Resume Next
    ' read the current focused hier csv
    myFile = GbsLoc & wrkfile
    ReadBile
    LoadDsv wrkr
    MsgCnt = MsgCnt + 1
    BackServe.ShowMsgCnt
    BackServe.Phoning wrkr
    On Error GoTo 0
End Sub
Public Sub AppendName(ByVal phonr As String, ByVal wrkfile As String)
Dim wrkr As Range
    Set wrkr = NextOpenRange("Phones", PhoneHdrR, PhoneHdrC, 0)
    On Error Resume Next
    ' read the current focused hier csv
    myFile = GbsLoc & wrkfile
    ReadBile
    
    BackServe.AddToPhones phonr
    On Error GoTo 0
End Sub

' not currently used
Public Sub AppendPhone(ByVal wrkfile As String)
Dim wrkr As Range
    Set wrkr = NextOpenRange("Phones", PhoneHdrR, PhoneHdrC, 0)
    On Error Resume Next
    ' read the current focused hier csv
    myFile = GbsLoc & wrkfile
    ReadBile
    LoadDsv wrkr
    On Error GoTo 0
End Sub
'
' funnel current focus hier csv stream into Work area
'
Public Sub LoadCsv(ByVal shtr As String, ByVal arear As String)
    Dim idxer As Integer
    Dim chrer As Byte
    Dim qter As Boolean
    Dim qtpn As Integer
    Dim contr As String
    
    ' On Error Resume Next
    ' walk through all the cells of the work area
    ' parallel to the parsing of textline
    idxer = 1
    For Each m In Application.Sheets(shtr).Range(arear)
        qter = False
        contr = ""
        Do While idxer <= Len(textline)
            chrer = Asc(Mid(textline, idxer, 1))
            If qter Then
                If chrer = &H22 Then
                    If (idxer - qtpn) > 1 Then
                        contr = Mid(textline, qtpn + 1, idxer - qtpn - 1)
                    Else
                        contr = ""
                    End If
                    qter = False
                Else
                End If
            Else
                If chrer = &H22 Then
                    qter = True
                    qtpn = idxer
                Else
                    If chrer = &H2C Then
                        m.value = contr
                        contr = ""
                        idxer = idxer + 1
                        Exit Do
                    Else
                        
                    End If
                    
                End If
            End If
            idxer = idxer + 1
        Loop
        If idxer > Len(textline) Then Exit For
    Next
    ' On Error GoTo 0
End Sub

Public Sub LoadDsv(ByVal rngr As Range)
    Dim idxer As Integer
    ' Dim chrer As Byte
    ' Dim qter As Boolean
    ' Dim qtpn As Integer
    ' Dim contr As String
    
    ' On Error Resume Next
    ' walk through all the cells of the work area
    ' parallel to the parsing of textline
    idxer = 1
    For Each m In rngr
        idxer = AssignCell(m, idxer)
        If idxer > Len(textline) Then Exit For
    Next
    ' On Error GoTo 0
End Sub
'
' save a region into a data stream for later retrieval
'
Public Sub SaveRegion(ByVal arear As String, ByVal wrkfile As String)
    On Error Resume Next
    ' create the csv string
    SaveCsv "Gwizard", arear
    ' write the Work area to current focus hier csv
    myFile = GbsLoc & wrkfile
    WriteBile
    On Error GoTo 0
End Sub
'
' save a region into a data stream for later retrieval
'
Public Sub SaveActive(ByVal arear As String, ByVal wrkfile As String)
    On Error Resume Next
    ' create the csv string
    SaveCsv Application.ActiveSheet.Name, arear
    ' write the Work area to current focus hier csv
    myFile = wrkfile
    WriteBile
    On Error GoTo 0
End Sub
'
' funnel current focus hier csv stream into Work area
'
Public Sub LoadRegion(ByVal arear As String, ByVal wrkfile As String)
    ' clear data in target area
    Application.Sheets("Raw").Range(arear).Clear
    On Error Resume Next
    ' read the current focused hier csv
    myFile = GbsLoc & wrkfile
    ReadBile
    LoadCsv "Raw", arear
    On Error GoTo 0
End Sub
'
' funnel current focus hier csv stream into Work area
'
Public Sub LoadActive(ByVal arear As String, ByVal wrkfile As String)
    ' clear data in target area
    Application.ActiveSheet.Range(arear).Clear
    ' On Error Resume Next
    ' read the current focused hier csv
    myFile = wrkfile
    ReadBile
    LoadCsv Application.ActiveSheet.Name, arear
    ' On Error GoTo 0
End Sub
Public Sub Summed(ByVal arear As String, ByVal wrkfile As String, ByVal dated As String)
    LoadActive arear, wrkfile
    ImrShop.AnSummed dated
End Sub
Public Sub Cycler()
    ImrShop.AnCycler
End Sub
'
' Excel utilities
'
Public Sub PlatCopy()
    Application.CutCopyMode = False
    Selection.Copy
End Sub
Public Function HasCmb() As Boolean
    HasCmb = (Len(textline) > 0) And Not (Left(textline, 1) = ".")
End Function
Public Function ULcell(ByVal arear As String) As String
    ULcell = Mid(arear, 1, InStr(arear, ":") - 1)
End Function


Public Function TimeStamp(iNow As Date) As String
Dim d(1 To 6)
Dim i As Integer
Dim restr As String
d(1) = Year(iNow)
d(2) = Month(iNow)
d(3) = Day(iNow)
d(4) = Hour(iNow)
d(5) = Minute(iNow)
d(6) = Second(iNow)
restr = CStr(d(1))

For i = 2 To 6
    If d(i) < 10 Then restr = restr & "0"
    restr = restr & d(i)
    ' If i = 3 Then TimeStamp = TimeStamp & " "
Next i
TimeStamp = restr
End Function


'
' Sorting and filtering
'
Public Sub SortAZ(myListBox As Variant)
'Create variables
Dim j As Long
Dim i As Long
Dim temp As Variant
'Use Bubble sort method to put listBox in A-Z order
With myListBox
    For j = 0 To .ListCount - 2
        For i = 0 To .ListCount - 2
            If LCase(.List(i)) > LCase(.List(i + 1)) Then
                temp = .List(i)
                .List(i) = .List(i + 1)
                .List(i + 1) = temp
            End If
        Next i
    Next j
End With

End Sub
Function Rendate(ByVal timestr As String) As String
    Dim idxa As Integer
    Dim idxb As Integer
    Dim txa As String
    
    idxa = InStr(1, timestr, "_")
    idxb = InStr(idxa + 1, timestr, ".")
    txb = Mid(timestr, idxa + 1, idxb - idxa - 1)
    txa = Mid(timestr, 1, idxa - 1)
    If Len(txb) < 6 Then
        txb = Right("000000" & txb, 6)
    End If
    txa = Mid(txb, 1, 2) & ":" & Mid(txb, 3, 2) _
                        & ":" & Mid(txb, 5, 2) _
                        & " " & Mid(txa, 3, 2) _
                        & "/" & Mid(txa, 5, 2) _
                        & "/20" & Mid(txa, 1, 2)
    Rendate = txa
End Function
Function SortOrder2(myListBox As Variant, ByVal elem As Integer, ByVal elem2 As Integer)
    SortOrder2 = (CDate(Rendate(myListBox.List(elem))) > CDate(Rendate(myListBox.List(elem2))))
End Function
'
' Sorting and filtering
'
Public Sub SortNum2(myListBox As Variant)
'Create variables
Dim j As Long
Dim i As Long
Dim temp As Variant
'Use Bubble sort method to put listBox in A-Z order
With myListBox
    For j = 0 To .ListCount - 2
        For i = 0 To .ListCount - 2
            If SortOrder2(myListBox, i, i + 1) Then
                temp = .List(i)
                .List(i) = .List(i + 1)
                .List(i + 1) = temp
            End If
        Next i
    Next j
End With

End Sub
'
' string utilities
'
Public Function hex2asc(ByVal text As String)
    Dim string5 As String
    Dim long1 As Integer
    Dim dbl As Double
    string5 = ""
    For long1 = 1 To Len(text) Step 2
        dbl = ConvertBaseNToDec(Mid(text, long1, 2))
        string5 = string5 & Chr(CInt(dbl))
    Next
    hex2asc = string5
End Function
Public Function asc2hex(ByVal text As String) As String
    Dim ascer As Integer
    Dim suber As Integer
    Dim hexer As String
    Dim i As Integer
    hexer = ""
    For i = 0 To Len(text) - 1
        ascer = Asc(Mid(text, i + 1, 1))
        suber = (ascer And &HF0) / 16
        ascer = ascer And &HF
        If suber > 9 Then
            suber = suber + 55
        Else
            suber = suber + 48
        End If
        If ascer > 9 Then
            ascer = ascer + 55
        Else
            ascer = ascer + 48
        End If
        hexer = hexer & Chr(suber) & Chr(ascer)
    Next
    asc2hex = hexer
End Function
Public Function ConvertBaseNToDec(ByVal dValue As String, Optional ByVal byBase As Byte = 16) As Double
    Const BASENUMBERS As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Dim lReturn As Double
    Dim n As Integer
    On Error Resume Next
    lReturn = 0#
    If (byBase < 2) Or (byBase > 36) Then
    Else
        n = 0
        Do
            If Err.Number = 0 Then
                lReturn = ((InStr(1, BASENUMBERS, Mid(dValue, Len(dValue) - n, 1)) - 1) * (byBase ^ n)) + lReturn
                n = n + 1
            Else
                Exit Do
            End If
        Loop Until n = Len(dValue)
    End If
    On Error GoTo 0
    ConvertBaseNToDec = lReturn
End Function

Public Sub NamedRaw(ByVal nmr As String)
RawName = nmr
Select Case RawName
Case "SmsSid"
 RawOrd = 1
Case "From"
 RawOrd = 2
Case "FromCity"
 RawOrd = 3
Case "FromState"
 RawOrd = 4
Case "FromZip"
 RawOrd = 5
Case "FromCountry"
 RawOrd = 6
Case "when"
 RawOrd = 7
Case "Body"
 RawOrd = 8
Case "Mtype"
 RawOrd = 9
Case "message"
 RawOrd = 10
Case "notes"
 RawOrd = 11
Case "NumMedia"
 RawOrd = 12
Case "srcfile"
 RawOrd = 13
Case "donemed"
 RawOrd = 14
Case "filer"
 RawOrd = 15
Case "desturl"
 RawOrd = 16
Case "Type"
 RawOrd = 17
Case "Url"
 RawOrd = 18
Case "Key"
 RawOrd = 19
Case "Fkey"
 RawOrd = 20
Case "SrxFile"
 RawOrd = 21
Case "label"
 RawOrd = 22
Case "accy"
 RawOrd = 23
Case "dest"
 RawOrd = 24
Case "Direction"
 RawOrd = 25
Case "ErrorCode"
 RawOrd = 26
Case "ErrorMessage"
 RawOrd = 27
Case "Status"
 RawOrd = 28
Case "Sid"
 RawOrd = 29
Case "To"
 RawOrd = 30
Case "Media1"
 RawOrd = 31
Case "Uri"
 RawOrd = 32
Case "MediaContentType0"
 RawOrd = 33
Case "MediaUrl0"
 RawOrd = 34
Case "Edit"
 RawOrd = 35
Case "Err"
 RawOrd = 36
Case Else
 RawOrd = 0
End Select
End Sub


Public Sub OrdRaw(ByVal ordr As Integer)
RawOrd = ordr
Select Case RawOrd
Case 1
 RawName = "SmsSid"
Case 2
 RawName = "From"
Case 3
 RawName = "FromCity"
Case 4
 RawName = "FromState"
Case 5
 RawName = "FromZip"
Case 6
 RawName = "FromCountry"
Case 7
 RawName = "when"
Case 8
 RawName = "Body"
Case 9
 RawName = "Mtype"
Case 10
 RawName = "message"
Case 11
 RawName = "notes"
Case 12
 RawName = "NumMedia"
Case 13
 RawName = "srcfile"
Case 14
 RawName = "donemed"
Case 15
 RawName = "filer"
Case 16
 RawName = "desturl"
Case 17
 RawName = "Type"
Case 18
 RawName = "Url"
Case 19
 RawName = "Key"
Case 20
 RawName = "Fkey"
Case 21
 RawName = "SrxFile"
Case 22
 RawName = "label"
Case 23
 RawName = "accy"
Case 24
 RawName = "dest"
Case 25
 RawName = "Direction"
Case 26
 RawName = "ErrorCode"
Case 27
 RawName = "ErrorMessage"
Case 28
 RawName = "Status"
Case 29
 RawName = "Sid"
Case 30
 RawName = "To"
Case 31
 RawName = "Media1"
Case 32
 RawName = "Uri"
Case 33
 RawName = "MediaContentType0"
Case 34
 RawName = "MediaUrl0"
Case 35
 RawName = "Edit"
Case 36
 RawName = "Err"
Case Else
 RawName = ""
End Select
End Sub

Public Sub WorkedOrd(ByVal nmr As String)
WorkName = nmr
Select Case WorkName
 Case "Select"
    WorkOrd = 1
 Case "Image"
    WorkOrd = 2
 Case "Phone"
    WorkOrd = 3
 Case "First"
    WorkOrd = 4
 Case "Last"
    WorkOrd = 5
 Case "Date/Time"
    WorkOrd = 6
 Case "Text"
    WorkOrd = 7
 Case "Notes"
    WorkOrd = 8
 Case "OfRaw"
    WorkOrd = 9
 Case Else
    WorkOrd = 0
End Select
End Sub

Public Function SaveSheetNames() As Boolean
Dim shtr As Worksheet
Dim shts As String
    shts = ""
    For Each shtr In Application.ActiveWorkbook.Sheets
        shts = shts & shtr.Name & "|" & vbCrLf
    Next
    textline = shts
    myFile = AbsLoc & "Bin\Serv\Sheets.txt"
    WriteBile
    SaveSheetNames = True
End Function

Public Function GetSheetFrom(ByVal directory As String, ByVal FileName As String, ByVal shtr As String) As Integer
    Dim total As Integer
    Dim workb As String
    workb = Application.ActiveWorkbook.Name
    total = Application.ActiveWorkbook.Worksheets.Count
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Open directory & FileName
    
    Application.Workbooks(FileName).Worksheets(shtr).Copy _
                    After:=Application.Workbooks(workb).Worksheets(total)
    Application.Workbooks(FileName).Close
    total = Application.Workbooks(workb).Worksheets.Count

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    GetSheetFrom = total
End Function

Public Function PutSheetBack(ByVal directory As String, ByVal FileName As String, ByVal shtr As String) As Integer
    Dim total As Integer
    Dim sotal As Integer
    Dim workb As String
    Dim sheetr As Worksheet
    On Error Resume Next
    workb = Application.ActiveWorkbook.Name
    total = Application.ActiveWorkbook.Worksheets.Count
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Open directory & FileName
    
    sotal = Application.Workbooks(FileName).Worksheets.Count
    ' Application.Workbooks(fileName).Worksheets(shtr).Delete
    Application.Workbooks(workb).Worksheets(shtr).Copy To:=Application.Workbooks(FileName)
    
    ' after:=Application.Workbooks(fileName).Worksheets(sotal - 1)
    Application.Workbooks(FileName).Save
    Application.Workbooks(FileName).Close
    ' Application.Workbooks(workb).Worksheets(shtr).Delete
    ' sotal = Application.Workbooks(workb).Worksheets.Count
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    PutSheetBack = sotal
    On Error GoTo 0
End Function

Public Function Migrate() As Boolean
Dim wrks As String
Dim wrkb As Workbook
    ' creates a new workbook with all of the sheets in this workbook
    ActiveWorkbook.Sheets.Copy
    ' save the new workbook as the target of sheet absorption, no macros
    wrks = AbsLoc & "BackServe\HolderTarget.xlsx"
    Set wrkb = Application.Workbooks(2)
    wrkb.Close SaveChanges:=True, FileName:=wrks
    Migrate = True
End Function

Public Function Rebirth(ByVal shtsx As String) As Integer
Dim wrkc As Integer
Dim wrks As String
Dim idxr As Integer
Dim wrkb As Workbook
Dim actb As Workbook
    wrkc = 0
    Set actb = ActiveWorkbook
    Set wrkb = Application.Workbooks.Open(shtsx)
    For idxr = 2 To wrkb.Sheets.Count
        actb.Sheets.Copy After:=wrkb.Sheets(idxr)
        wrkc = wrkc + 1
    Next
    wrkb.Close SaveChanges:=False
    Rebirth = wrkc
End Function

Public Sub ImportRaw()
        
    On Error Resume Next
    ' read the current focused hier csv
    myFile = AbsLoc & "Results\RawX.csv"
    ReadBile
    LoadCsv "Raw", "F3:AO65000"
    On Error GoTo 0
End Sub

Public Sub ImportPhones()
    On Error Resume Next
    ' read the current focused hier csv
    myFile = AbsLoc & "Results\PhonesX.csv"
    ReadBile
    LoadCsv "Phones", "B3:M65000"
    On Error GoTo 0
End Sub

Public Sub ExportRaw()
Dim wrkr As Range
    Set wrkr = NextOpenRange("Raw", RawHdrR, RawHdrC, 6)
    
    SaveCsv "Raw", "F3:AO" & CStr(wrkr.Row)
    
    On Error Resume Next
    ' read the current focused hier csv
    myFile = AbsLoc & "Results\RawX.csv"
    WriteBile
    On Error GoTo 0
End Sub


Public Sub ExportPhones()
Dim wrkr As Range
    Set wrkr = NextOpenRange("Phones", PhoneHdrR, PhoneHdrC, 0)
    
    SaveCsv "Phones", "B3:M" & CStr(wrkr.Row)
    
    On Error Resume Next
    ' read the current focused hier csv
    myFile = AbsLoc & "Results\PhonesX.csv"
    WriteBile
    On Error GoTo 0
End Sub