''ORACLE FORMATS TO TEXT- Missing is an ISO LIST in EXCEL of the COUNTRY/STATE codes.
Attribute VB_Name = "tEXTtOOLS"

Option Explicit

Function CleanString(strString As String)
Dim result, re

   Set re = New RegExp
   With re
    .Global = True
    .IgnoreCase = True
    '''http://www.regular-expressions.info/vbscriptexample.html
    '''regex   =      *.  9999    .  RFA or RVT or RTE
    ''.Pattern = ".*?(\.)(\d{4})(\.)(rfa|rvt|rte)"
    .Pattern = "[^A-Z,0-9,a-z]"
    CleanString = .Replace(strString, "_")
   End With


Set re = Nothing
End Function

Function SplitOracle(strOracle As String, Optional retval As Integer)
''United States/CA/San Diego/US - San Diego, CA - 401 West A Street
retval = retval - 1
Dim result, re, objRow
Dim ISO As ListObject
Set ISO = shtISO3166.ListObjects("ISO3166x")
       
On Error GoTo SplitOracle_Err

   Set re = New RegExp
   With re
    .Global = True
    .IgnoreCase = True
    .Pattern = "(.*?)(?:\/|,|$)"
    ''CleanString = .Replace(strString, "_")
    Set result = .Execute(Trim(strOracle))
   End With
  
   If retval > result.count - 1 Then retval = result.count
  
    SplitOracle = UCase(result(retval).Value)
    SplitOracle = Trim(Left(SplitOracle, Len(SplitOracle) - 1))
  
    ''UNITED STATES OF AMERICA (THE) is proper ISO3166 formats the name
    If SplitOracle = "UNITED STATES" Then SplitOracle = UCase("United States of America (the)") ''commonly malformed entry IN ORACLE
       
   Select Case retval
    Case 0: ''country code

        For Each objRow In ISO.DataBodyRange.Rows
            If UCase(objRow.Cells(1, 1)) Like "*" & SplitOracle & "*" Then
                SplitOracle = UCase(objRow.Cells(1, 4).Value)
                Exit For
            End If
        Next objRow

    Case Else:
        With re
         .Global = True
         .IgnoreCase = True
         .Pattern = "[^A-Z,0-9,a-z]"
         ''CleanString = .Replace(strString, "_")
         SplitOracle = .Replace(SplitOracle, "_")
        End With
    End Select


GoTo SplitOracle_cleanup:
SplitOracle_Err:
SplitOracle = "#ERR"

SplitOracle_cleanup:
Set re = Nothing

End Function

Function OracleToName(strOracle As String)

''United States/CA/San Diego/US - San Diego, CA - 401 West A Street
Dim result, re, objRow
Dim intResults As Integer
Dim arrX() As String
Dim I As Integer

Dim ISO As ListObject
Set ISO = shtISO3166.ListObjects("ISO3166x")
       
On Error GoTo OracleToName_cleanup_Err

   Set re = New RegExp
   With re
    .Global = True
    .IgnoreCase = True
    .Pattern = "(.*?)(?:\/|,|$)"
    ''CleanString = .Replace(strString, "_")
    Set result = .Execute(Trim(strOracle))
   End With
   intResults = result.count - 1
  
   ReDim arrX(0 To intResults)
  
   For I = 0 To intResults

    ''regexp doesn't behave exactly correctly to the vanilla version- clean up delimeters:
    arrX(I) = UCase(result(I).Value) ''set workable value
   
    Do While Right(arrX(I), 1) = "/" Or Right(arrX(I), 1) = "," Or Right(arrX(I), 1) = " " Or Right(arrX(I), 1) = "\"
        arrX(I) = Trim(Left(arrX(I), Len(arrX(I)) - 1))
    Loop

    ''UNITED STATES OF AMERICA (THE) is proper ISO3166 formats the name
    If arrX(I) = "UNITED STATES" Then arrX(I) = UCase("United States of America (the)")   ''commonly malformed entry IN ORACLE
      
    Select Case I
    Case 0: ''country code
   
        For Each objRow In ISO.DataBodyRange.Rows
            If UCase(objRow.Cells(1, 1)) Like "*" & arrX(I) & "*" Then
                arrX(I) = UCase(objRow.Cells(1, 4).Value)
                Exit For
            End If
        Next objRow
   
    Case Else:
        With re
         .Global = True
         .IgnoreCase = True
         .Pattern = "[^A-Z,0-9,a-z]"
         ''CleanString = .Replace(strString, "_")
         arrX(I) = .Replace(arrX(I), "_")
        End With
    End Select
    Next I

    I = 0
    Do While arrX(I) > ""
        If I > 0 Then OracleToName = OracleToName & "."
        OracleToName = OracleToName & arrX(I)
        I = I + 1
    Loop


GoTo OracleToName_cleanup:
''''''''''''''''''''''''''''''''''''''''''''''''
'''error out
OracleToName_cleanup_Err:
'MsgBox Err.Description, vbCritical + vbOKOnly
'Stop
'Resume
'
''VBA provides a function called CVErr that takes a numeric input parameter
'specifying the error and returns a real error value that Excel will recognize
'as an error. The values of the input parameter to CVErr are in the XLCVError
'Enum and are as follows:
'
'xlErrDiv0 (= 2007) returns a #DIV/0! error.
'xlErrNA (= 2042) returns a #N/A error.
'xlErrName (= 2029) returns a #NAME? error.
'xlErrNull (= 2000) returns a #NULL! error.
'xlErrNum (= 2036) returns a #NUM! error.
'xlErrRef (= 2023) returns a #REF! error.
'xlErrValue (= 2015) returns a #VALUE! error.
OracleToName = CVErr(xlErrNA)

'''''''''''''''''''''''''''''''''''''''''''''''''''
''exit clean
OracleToName_cleanup:
    Set re = Nothing
   
End Function


Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer