Option Compare Database
Option Explicit
'api declarations
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function SQLAllocEnv% Lib "odbc32.dll" (env&)
Declare Function SQLDataSources% Lib "odbc32.dll" (ByVal Henv&, ByVal fdir%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDesc$, ByVal cbDescMax%, pcbDesc%)
Declare Function AC_XSI_UtilGetCardStatus Lib "acbsiprov.DLL" (ByVal lngHcard As Long, ByVal strCardName As String, ByVal lngNameLen As Long) As Long
Declare Function AC_XSI_UtilGetReaderList Lib "acbsiprov.DLL" (ByRef strReaders As Variant, ByRef lngReadersLen As Long) As Long
Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hDbc&, phstmt&) As Integer
Declare Function SQLTables Lib "odbc32.dll" (ByVal hstmt&, szTblQualifier As Any, ByVal cbTblQualifier%, szTblOwner As Any, ByVal cbTblOwner%, szTblName As Any, ByVal cbTblName%, szTblType As Any, ByVal cbTblType%) As Integer
Declare Function SQLFetch Lib "odbc32.dll" (ByVal hstmt&) As Integer
Declare Function SQLGetData Lib "odbc32.dll" (ByVal hstmt&, ByVal icol%, ByVal fCType%, ByVal rgbValue As String, ByVal cbValueMax&, pcbValue&) As Integer
Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal hstmt&, ByVal fOption%) As Integer
Declare Function SQLError Lib "odbc32.dll" (ByVal Henv&, ByVal hDbc&, ByVal hstmt&, ByVal szSqlState$, pfNativeError&, ByVal szErrorMsg$, ByVal cbErrorMsgMax%, pcbErrorMsg%) As Integer
' Containers
Const PERSON_CONTAINER = &H1
Const PERSONNEL_CONTAINER = &H2
Const BENEFITS_CONTAINER = &H4
Const OTHER_BENEFITS_CONTAINER = &H10
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1
' Global Variables
Global oCac As DMDCCACLib.CommonAccessCard
Global glbLoginSucceeded As Boolean
Global glbstrPin As String
Const BSI_OK = 0 ' Execution completed successfully */
Const BSI_ACCESS_DENIED = -30001 ' Access conditions are not fulfilled */
Const BSI_BAD_AID = -30002 'The card application of the given AID cannot be found on the card */
Const BSI_BAD_ALGO_ID = -30003 'The algorithm ID provided to the cryptographic Provider is not supported. */
Const BSI_BAD_AUTH = -30004 'Authenticator value or type is not correct */
Const BSI_BAD_HANDLE = -30005 'Unknown card handle */
Const BSI_BAD_PARAM = -30006 'Incorrect parameter value */
Const BSI_BAD_TAG = -30007 'Incorrect parameter value */
Const BSI_CARD_ABSENT = -30008 'There is no card in the reader */
Const BSI_CARD_NOT_INIT = -30009 'The smart card is not yet initialized */
Const BSI_CARD_PRESENT = -30010 'There is a card in the reader */
Const BSI_CARD_REMOVED = -30011 'The connected smart card has been removed */
Const BSI_CARD_RESET = -30012 'The communication with the card was reset */
Const BSI_COMM_ERROR = -30013 'Error during communication with the card */
Const BSI_CREATE_ERROR = -30014 'Error creating data in Generic Container */
Const BSI_DATA_CORRUPTED = -30015 'The provider has detected that the data read from the smart card is corrupted. */
Const BSI_DELETE_ERROR = -30016 'Error deleting data in Generic Container */
Const BSI_INSUFFICIENT_BUFFER = -30017 'The buffer provided to retrieve data is too small */
Const BSI_LOAD_LIB_FAILED = -30018 'Loading of card communication library failed */
Const BSI_NO_MORE_DATA = -30019 'No space available for data creation in container */
Const BSI_NOT_IMPLEMENTED = -30020 'The service is not implemented in the API version */
Const BSI_PIN_LOCKED = -30021 'The card is locked because too many wrong PIN have been entered */
Const BSI_READ_ERROR = -30022 'Error reading data in Generic Container or getting a Certificate */
Const BSI_SERVICE_NOT_AVAILABLE = -30023 'The card does not implement a BSI service required by the Application. */
Const BSI_UNKNOWN_ERROR = -30024 'An error occurred but the cause is unknown */
Const BSI_UNKNOWN_READER = -30025 'Unknown reader */
Const BSI_UPDATE_ERROR = -30026 'Error updating data in Generic Container */
Const BSI_ACR_NOT_AVAILABLE = -30027 'The card or applet does not support the access control rule for which the application was attempting to establish a security context. */
Const XSI_WEAK_PIN = -30028 'The PIN does not follow weak PIN policy */
Const XSI_INVALID_PIN_LENGTH = -30029 'The PIN length does not follow Min/Max PIN length requirements */
Global Const SQL_NTS As Long = -3
Global Const SQL_MAX_MESSAGE_LENGTH As Long = 512
Global Const SQL_NO_DATA_FOUND As Long = 100
Global Const SQL_CHAR As Long = 1
Global Const SQL_C_CHAR As Long = SQL_CHAR
Global Const SQL_CLOSE As Long = 0
'Win32 API declaration
Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
' Constants used to detect clicking on the icon
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONUP = &H205
' Constants used to control the icon
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIF_MESSAGE = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
' Used as the ID of the call back message
Public Const WM_MOUSEMOVE = &H200
' Used by Shell_NotifyIcon
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
'create variable of type NOTIFYICONDATA
Public TrayIcon As NOTIFYICONDATA
Public Function ReadCac()
Dim boolConnect As Boolean
Dim retBool As Boolean
Dim strSSN As String
Dim rsData As Recordset
Dim strSQL As String
Dim con As Object
With Forms!check_in
boolConnect = ConnectToCard(.txtPIN, "Dell USB Keyboard Smart Card Reader 0")
.txtPIN = ""
If boolConnect = True Then
strSSN = Right(String(10, "0") + ReadDataFromCard("PersonIdentifier"), 10)
strSQL = "SELECT * FROM PERSON WHERE SSN = '" + strSSN + "'"
Set con = Application.CurrentProject.Connection
Set rsData = CreateObject("ADODB.Recordset")
rsData.Open strSQL, con, 1
'Set rsData = CurrentDb.Execute(strSQL, 1)
If rsData.RecordCount > 0 Then
.txtSSN.SetFocus
DoCmd.FindRecord strSSN, , True, , True
Else
DoCmd.GoToRecord , , acNewRec
End If
Set rsData = Nothing
.txtSSN = strSSN
.txtTime = Format(Now, "HHNN")
.txtFirstName = ReadDataFromCard("FirstName")
.txtMiddleInitial = Left(ReadDataFromCard("MiddleName"), 1)
.txtLastName = ReadDataFromCard("LastName")
.txtRankID = ReadDataFromCard("Rank")
.txtPresentGradeCode = ReadDataFromCard("PayPlan") + ReadDataFromCard("PayGrade")
.txtGender = Left(Trim(ReadDataFromCard("GenderDesc")), 1)
retBool = DisconnectFromCard
' Else
' MsgBox "Cannot read card", vbOKOnly
End If
End With
End Function
Public Function GetODBCTables(ByVal hDbc As Long, Optional Owner = True, Optional TableType = "'TABLE', 'VIEW', 'SYSTEM TABLE'") As Variant
On Error GoTo ehGetDSNTables
Dim intHstmt As Long
Dim intRc As Integer
Dim strErrMsg As String * SQL_MAX_MESSAGE_LENGTH
Dim strSqlState As String * 5
Dim arrTables() As Variant
Dim intCounter As Integer
Dim strTable As String
Dim strName As String * 255
Dim strOwner As String * 255
Dim lngLenRead As Long
Dim Henv As Long
intRc = SQLAllocStmt(ByVal hDbc, intHstmt)
intRc = SQLTables(ByVal intHstmt, ByVal 0&, SQL_NTS, ByVal 0&, SQL_NTS, ByVal 0&, SQL_NTS, ByVal CStr(TableType), Len(TableType))
If intRc <> SQL_SUCCESS Then
GoTo ehGetDSNTables
End If
strOwner = String(255, 0) 'Init string to hold data.
strName = String(255, 0) 'Init string to hold data.
intRc = SQLFetch(intHstmt)
If intRc <> SQL_SUCCESS Then
GoTo ehGetDSNTables
End If
intCounter = 0
ReDim Preserve arrTables(intCounter)
While intRc <> SQL_NO_DATA_FOUND
intRc = SQLGetData(ByVal intHstmt, 2, SQL_C_CHAR, ByVal strOwner, 254, lngLenRead)
intRc = SQLGetData(ByVal intHstmt, 3, SQL_C_CHAR, ByVal strName, 254, lngLenRead)
strTable = IIf(Owner, Mid(strOwner, 1, InStr(strOwner, Chr(0)) - 1) & ".", "")
strTable = strTable & Mid(strName, 1, InStr(strName, Chr(0)) - 1)
'remove the dot if there is no table owner returned
If Left(strTable, 1) = "." Then
strTable = Mid(strTable, 2)
End If
ReDim Preserve arrTables(intCounter)
arrTables(intCounter) = strTable
intCounter = intCounter + 1
strOwner = String(255, 0) 'Init string to hold data.
strName = String(255, 0) 'Init string to hold data.
intRc = SQLFetch(intHstmt)
Wend
intRc = SQLFreeStmt(ByVal intHstmt, SQL_CLOSE)
GetODBCTables = arrTables
Exit Function
ehGetDSNTables:
intRc = SQLError(ByVal Henv, ByVal hDbc, ByVal intHstmt, strSqlState, 0, strErrMsg, SQL_MAX_MESSAGE_LENGTH, 0)
Debug.Print "(" & strSqlState & ")" & strErrMsg
End Function
Public Sub GetCacFields(ByRef frmCurrent As Form)
Dim X As Integer
With frmCurrent.cboCacFields(0)
.Clear
.AddItem "*DateTimeStamp"
.AddItem "*WholeName"
.AddItem "FirstName"
.AddItem "MiddleName"
.AddItem "LastName"
.AddItem "Cadency"
.AddItem "GenderCode"
.AddItem "GenderDesc"
.AddItem "GenderDDDSCode"
.AddItem "PersonDoDEDI"
.AddItem "PersonIdentifier"
.AddItem "PersonIdentifierTypeCode"
.AddItem "PersonIdentifierTypeDesc"
.AddItem "PersonIdentifierTypeDDDSCode"
.AddItem "DateOfBirth"
.AddItem "BloodTypeCode"
.AddItem "BloodTypeDesc"
.AddItem "BloodTypeDDDSCode"
.AddItem "OrganDonorCode"
.AddItem "OrganDonorDesc"
.AddItem "OrganDonorDDDSCode"
.AddItem "CardIssueDate"
.AddItem "CardExpireDate"
.AddItem "DateCacDataLoaded"
.AddItem "DateCacDataExpires"
.AddItem "ExchangeCode"
.AddItem "ExchangeCodeDesc"
.AddItem "CommissaryCode"
.AddItem "CommissaryCodeDesc"
.AddItem "MWRCode_sCode"
.AddItem "MWRCodeDesc"
.AddItem "DirectCareCode"
.AddItem "DirectCareDesc"
.AddItem "DirectCareDDDSCode"
.AddItem "CHCCode_sCode"
.AddItem "CHCDesc_sCode"
.AddItem "DirectCareEndDate"
.AddItem "NonMedicalBenefitsEndDate"
.AddItem "MealPlanCode"
.AddItem "BranchOfServiceCode"
.AddItem "BranchOfServiceDesc"
.AddItem "BranchOfServiceDDDSCode"
.AddItem "PersonnelCategoryCode"
.AddItem "PersonnelCategoryDesc"
.AddItem "PersonnelCategoryDDDSCode"
.AddItem "USGovernmentAgencyCode"
.AddItem "USGovernmentAgencyDesc"
.AddItem "USGovernmentAgencyDDDSCode"
.AddItem "NonUSGovernmentAgencyCode"
.AddItem "NonUSGovernmentAgencyDesc"
.AddItem "PayPlan"
.AddItem "PayGrade"
.AddItem "Rank"
.AddItem "DoDContractorFunctionCode"
.AddItem "DoDContractorFunctionDesc"
.AddItem "PersonnelEntitlementConditionTypeCode"
.AddItem "PersonnelEntitlementConditionTypeDesc"
.AddItem "*UserInput1"
.AddItem "*UserInput2"
.AddItem "*UserInput3"
.AddItem "*UserInput4"
.ListIndex = 0
End With
End Sub
Public Function ReadDataFromCard(ByVal strCacField) As String
On Error GoTo Connect_Error
Dim sValue As String
Dim strWholeName As String
Dim sCode As String
sValue = ""
Select Case strCacField
Case "DateTimeStamp"
sValue = Format(Now, "YYYY/MM/DD HH:MM:SS")
Case "WholeName"
oCac.getLastName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
strWholeName = sValue
oCac.getFirstName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
strWholeName = strWholeName + ", " + sValue
oCac.getMiddleName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
strWholeName = strWholeName + " " + sValue
sValue = strWholeName
Case "FirstName"
oCac.getFirstName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "MiddleName"
oCac.getMiddleName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "LastName"
oCac.getLastName sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "Cadency"
oCac.getCadency sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "GenderCode"
oCac.getGenderCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "GenderDesc"
oCac.getGenderDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonDODEDI"
oCac.getPersonDoDEDI sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonIdentifier"
oCac.getPersonIdentifier sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonIdentifierTypeCode"
oCac.getPersonIdentifierTypeCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "PersonIdentifierTypeDesc"
oCac.getPersonIdentifierTypeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonIdentifierTypeDDDSCode"
oCac.getPersonIdentifierTypeDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DateOfBirth"
oCac.getDateOfBirth sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "BloodTypeCode"
oCac.getBloodTypeCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "BloodTypeDesc"
oCac.getBloodTypeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "BloodTypeDDDSCode"
oCac.getBloodTypeDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "OrganDonorCode"
oCac.getOrganDonorCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "OrganDonorDesc"
oCac.getOrganDonorDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "OrganDonorDDDSCode"
oCac.getOrganDonorDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "CardIssueDate"
oCac.getCardIssueDate sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "CardExpireDate"
oCac.getCardExpireDate sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DateCacDataLoaded"
oCac.getDateCacDataLoaded sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DateCacDataExpires"
oCac.getDateCacDataExpires sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "ExchangeCode"
oCac.getExchangeCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "ExchangeCodeDesc"
oCac.getExchangeCodeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "CommissaryCode"
oCac.getCommissaryCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "CommissaryCodeDesc"
oCac.getCommissaryCodeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "MWRcode"
oCac.getMWRCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "MWRCodeDesc"
oCac.getMWRCodeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DirectCareCode"
oCac.getDirectCareCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "DirectCareDesc"
oCac.getDirectCareDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DirectCareDDDSCode"
oCac.getDirectCareDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "CHCCode"
oCac.getCHCCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "CHCDesc"
oCac.getCHCDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DirectCareEndDate"
oCac.getDirectCareEndDate sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "NonMedicalBenefitsEndDate"
oCac.getNonMedicalBenefitsEndDate sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "MealPlanCode"
oCac.getMealPlanCode sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "BranchOfServiceCode"
oCac.getBranchOfServiceCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "BranchOfServiceDesc"
oCac.getBranchOfServiceDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "BranchOfServiceDDDSCode"
oCac.getBranchOfServiceDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonnelCategoryCode"
oCac.getPersonnelCategoryCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "PersonnelCategoryDesc"
oCac.getPersonnelCategoryDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonnelCategoryDDDSCode"
oCac.getPersonnelCategoryDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "USGovernmentAgencyCode"
oCac.getUSGovernmentAgencyCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "USGovernmentAgencyDesc"
oCac.getUSGovernmentAgencyDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "USGovernmentAgencyDDDSCode"
oCac.getUSGovernmentAgencyDDDSCode sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "NonUSGovernmentAgencyCode"
oCac.getNonUSGovernmentAgencyCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "NonUSGovernmentAgencyDesc"
oCac.getNonUSGovernmentAgencyDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PayPlan"
oCac.getPayPlan sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PayGrade"
oCac.getPayGrade sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "Rank"
oCac.getRank sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "DoDContractorFunctionCode"
oCac.getDoDContractorFunctionCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "DoDContractorFunctionDesc"
oCac.getDoDContractorFunctionDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
Case "PersonnelEntitlementConditionTypeCode"
oCac.getPersonnelEntitlementConditionTypeCode sCode
sCode = RigNullChar(StrConv(sCode, vbUnicode))
Case "PersonnelEntitlementConditionTypeDesc"
oCac.getPersonnelEntitlementConditionTypeDesc sCode, sValue
sValue = RigNullChar(StrConv(sValue, vbUnicode))
End Select
ReadDataFromCard = sValue
Exit Function
Connect_Error:
MsgBox Err.Number & " - " & Err.Description, , "Error: Connect"
ReadDataFromCard = Err.Description
End Function
Public Function RigNullChar(ByVal str As String) As String
' Remove the null character from the string
On Error GoTo RigNullChar_Error
Dim i As Long
i = InStr(str, vbNullChar)
If i > 0 Then
RigNullChar = Left(str, i - 1)
Else
RigNullChar = str
End If
Exit Function
RigNullChar_Error:
RigNullChar = ""
End Function
Public Function ConnectToCard(ByVal strPin As String, ByVal strReader As String) As Boolean
On Error GoTo Connect_Error
Dim containers As Long
ConnectToCard = False
' Create CAC Object
Set oCac = New DMDCCACLib.CommonAccessCard
' Connect to the card
Call oCac.ConnectToCard(StrConv(strReader, vbFromUnicode), Len(strReader))
' Container
containers = PERSON_CONTAINER
' PIN
Call oCac.logonToCard(StrConv(strPin, vbFromUnicode), Len(strPin))
ConnectToCard = True
Exit Function
Connect_Error:
MsgBox "Can't connect to card. Check PIN", vbCritical
Set oCac = Nothing
End Function
Public Function DisconnectFromCard()
On Error GoTo Connect_Error
DisconnectFromCard = False
'oCac.logoffFromCard
Beep
Beep
oCac.DisconnectFromCard
Set oCac = Nothing
DisconnectFromCard = True
Exit Function
Connect_Error:
MsgBox Err.Number & " - " & Err.Description, , "Error: Connect"
Set oCac = Nothing
End Function
Public Function GetCacField(ByVal strField As String) As String
On Error GoTo ErrorReading
GetCacField = ""
GetCacField = Trim(Left(strField, InStr(strField, "<") - 1))
Exit Function
ErrorReading:
End Function
Public Function GetSqlField(ByVal strField As String) As String
On Error GoTo ErrorReading
GetSqlField = ""
GetSqlField = Trim(Mid(strField, InStr(strField, ">") + 1))
Exit Function
ErrorReading:
End Function