''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

Powerpoint countdown and current time in slides VBA

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