Mike Swanson
5359e7c49e
Recovered Darv's VB6 source for the Valley Wide Plastering Orders application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used). This is the first time we've had the actual source — prior session only had a single frmPayroll.frm from the AD server. Three project variants identified across two snapshots: - Full-Project/ (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\ - Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\ - Source/ (170 files, 559 MB) — D:\Office-Estimates\Darv\Source\ wholesale - SOURCE-HOLD/ (3 files, 1 MB) — D:\Office-Estimates\Darv\SOURCE HOLD\ Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production Orders_10A.exe was live as of April 2024 — open question whether newer source exists on other backup drives Mike will scan next. Also includes per-category and per-keyword analysis CSVs from a WizTree file-list export, plus the analyzer script that produced them (re-runnable for the next drive's CSV). VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
658 lines
18 KiB
QBasic
658 lines
18 KiB
QBasic
Attribute VB_Name = "modADO"
|
|
Option Explicit
|
|
|
|
Global cb As Long 'Used to store CODE4 pointer
|
|
Global db As Long 'Used to store DATA4 pointer
|
|
Global db2 As Long 'Used to store DATA4 pointer
|
|
Global rc As Integer 'Used as general return code
|
|
Global rc2 As Integer 'Used as general return code
|
|
Global ind As Integer
|
|
|
|
Global lf As String 'Line Feed
|
|
Global fPath As String 'Full path name to data files
|
|
Global configCode As Long 'What type of DLL being used?
|
|
|
|
'loop counters
|
|
Global i As Integer, j As Integer
|
|
|
|
Public goConn As New Connection
|
|
Public goConn2 As New ADODB.Connection
|
|
Public gstrCOMPANY As String
|
|
Public gstrARCODE As String
|
|
Public gstrBEGDATE As String, gstrENDDATE As String
|
|
Public gintDEST As Integer, gintCOPY As Integer
|
|
Public gintLOTID As Integer, gintPERCENT As Integer
|
|
Public gintPROJID As Integer, glngORDERID As Long
|
|
Public gintOPTID As Integer, gboolMAS90 As Boolean
|
|
Public gintREPAIRID As Integer, gintORDER As Integer
|
|
Public gintESTID As Integer, gstrPO As String
|
|
Public gstrLOGIN As String, gbytSECURITY As Byte
|
|
Public gintCREWID As Integer, gstrCREW As String
|
|
Public gstrFLAG As String, gstrPONUM As String, gstrTYPE As String
|
|
Public gboolPRINT As Boolean, gboolLOGIN As Boolean, gstrMODULE As String
|
|
Public gboolTYPE As Boolean
|
|
|
|
Public gconACTION As Byte ' 1 = Add, 2 = Change, 3 = Delete, 5 = Copy
|
|
|
|
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
|
|
|
|
Public Const LB_SETTABSTOPS = &H192
|
|
|
|
Public Sub Main()
|
|
Dim boolPerform As Boolean
|
|
Dim boolPerform2 As Boolean
|
|
|
|
On Error GoTo Error_EH
|
|
|
|
' Screen.MousePointer = vbHourglass
|
|
|
|
' boolPerform = DataOpen(goConn)
|
|
|
|
' If boolPerform Then
|
|
|
|
cb = code4init() 'Initialize CodeBasic
|
|
If cb = 0 Then
|
|
MsgBox "CMS Database Open Failure - Closing Program", vbCritical + vbOKOnly, "File Open Error"
|
|
Exit Sub
|
|
Else
|
|
' configCode = u4switch() 'Determine what type of DLL being used
|
|
frmMain.Show
|
|
' ' Form1.Show (1) 'Show Form1 modally
|
|
End If
|
|
|
|
' rc = code4initUndo(cb) 'Close everything and free resources
|
|
|
|
' End If
|
|
|
|
' Set goConn2 = New ADODB.Connection
|
|
|
|
'Assuming default provider name
|
|
' goConn2.ConnectionString = "Provider=CodeBase;Location="
|
|
|
|
'Open connection
|
|
' goConn2.Open
|
|
|
|
' If goConn2.Errors.count = 0 Then
|
|
' frmMain.Show
|
|
' Else
|
|
' MsgBox "CMS Files Were Not Opened", vbInformation, "File Error"
|
|
' Exit Sub
|
|
' End If
|
|
|
|
'Data manipulation code...
|
|
|
|
'Cleanup
|
|
' cnn.Close
|
|
' Set cnn = Nothing
|
|
' boolPerform2 = DataOpen2(goConn2)
|
|
|
|
' If boolPerform2 Then
|
|
|
|
' cb = code4init() 'Initialize CodeBasic
|
|
' If cb = 0 Then
|
|
' configCode = u4switch() 'Determine what type of DLL being used
|
|
' frmMain.Show
|
|
' Form1.Show (1) 'Show Form1 modally
|
|
' Else
|
|
' MsgBox "CMS Database Open Failed"
|
|
' Set goConn2 = Nothing
|
|
' Exit Sub
|
|
' End If
|
|
|
|
' goConn2.Close
|
|
' Set goConn2 = Nothing
|
|
|
|
' End If
|
|
' Screen.MousePointer = vbDefault
|
|
Exit Sub
|
|
|
|
Error_EH:
|
|
gstrMODULE = "Module ADO2.BAS - Sub Main"
|
|
Call ErrorHandler2
|
|
gstrMODULE = ""
|
|
Exit Sub
|
|
End Sub
|
|
|
|
'Public Function DataOpen(oConn As Connection) As Boolean
|
|
' On Error GoTo Open_EH
|
|
'
|
|
' oConn.CursorLocation = adUseClient
|
|
|
|
' Set the connection string by calling
|
|
' a function.
|
|
' oConn.ConnectionString = ConnectString()
|
|
|
|
' Set the mode of the connection
|
|
' oConn.Mode = adModeReadWrite
|
|
|
|
' Open the Connection
|
|
' oConn.Open
|
|
|
|
' DataOpen = True
|
|
|
|
' Exit Function
|
|
|
|
'Open_EH:
|
|
' Call ErrorHandler(goConn)
|
|
' DataOpen = False
|
|
' Exit Function
|
|
'End Function
|
|
|
|
'Public Function DataOpen2(oConn2 As ADODB.Connection) As Boolean
|
|
'Public Function DataOpen2(oConn2 As Connection) As Boolean
|
|
' On Error GoTo Open_EH
|
|
|
|
' oConn2.CursorLocation = adUseClient
|
|
|
|
' Set the connection string by calling
|
|
' a function.
|
|
' oConn2.ConnectionString = ConnectString2()
|
|
' oConn2.ConnectionString = "Provider=CODEBASE;Location="
|
|
|
|
' Set the mode of the connection
|
|
' oConn2.Mode = adModeRead ' = adModeReadWrite
|
|
|
|
' Open the Connection
|
|
' oConn2.Open
|
|
|
|
' If oConn2.Errors.Count = 0 Then
|
|
' DataOpen2 = True
|
|
' End If
|
|
|
|
'Data manipulation code...
|
|
|
|
'Cleanup
|
|
|
|
' Exit Function
|
|
|
|
'Open_EH:
|
|
' Call ErrorHandler(goConn2)
|
|
' DataOpen2 = False
|
|
' Exit Function
|
|
'End Function
|
|
|
|
Public Function ConnectString() As String
|
|
Dim strDB As String
|
|
' SQL Server using an ODBC Data Source
|
|
'Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=DWW;Data Source=SOTAMAS90
|
|
' ConnectString = "DSN=VWPMAS90"
|
|
|
|
' "UID=DWW;PWD=;" & _
|
|
' "DATABASE=Employees"
|
|
|
|
' ConnectString = "DSN=SOTAMAS90;" & _
|
|
' "UID=DWW;PWD=;" ' & _
|
|
'"DATABASE="
|
|
|
|
|
|
' SQL Server using OLE DB Provider
|
|
'ConnectString = "Provider = sqloledb;" & _
|
|
' "Data Source = (local);" & _
|
|
' "Initial Catalog = Employees;" & _
|
|
' "User Id = sa;" & _
|
|
' "Password = ; "
|
|
|
|
' Jet MDB
|
|
strDB = App.Path & "\History.mdb"
|
|
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0" & _
|
|
";Data Source=" & strDB
|
|
' ";Data Source=vwp\vwp.mdb"
|
|
' "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=vwp\vwp.mdb"
|
|
' ";Data Source=vwp\vwp.mdb"
|
|
End Function
|
|
|
|
Public Function ConnectString2() As String
|
|
Dim strDB As String
|
|
' SQL Server using an ODBC Data Source
|
|
|
|
|
|
'Provider=MSDASQL.1;Persist Security Info=False;User ID=Admin;Data Source=CMS2;Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY
|
|
|
|
' ConnectString2 = "Provider=MSDASQL.1;Persist Security Info=False;User ID=Admin;Data Source=CMS2;Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"
|
|
'";User ID=Admin" & _
|
|
'";Data Source=CMS2" _
|
|
'";Initial Catalog=c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"
|
|
|
|
' ";User ID=SUP" & _
|
|
|
|
' strDB = App.Path
|
|
ConnectString2 = "Provider=CODEBASE;Location="
|
|
'& _
|
|
' ";Data Source=CMS2" & _
|
|
' ";Persist Security Info=False" & _
|
|
' ";Initial Catalog= " & strDB 'c:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\VB98\JIMMY"
|
|
|
|
End Function
|
|
|
|
'Public Sub ErrorHandler(oConn As Connection)
|
|
' Dim oErr As Error
|
|
' Dim strMSG As String
|
|
|
|
' For Each oErr In oConn.Errors
|
|
' strMSG = strMSG & _
|
|
' "Error #: " & _
|
|
' oErr.Number & vbCrLf
|
|
' strMSG = strMSG & _
|
|
' "Description: " & _
|
|
' oErr.Description & vbCrLf
|
|
' strMSG = strMSG & _
|
|
' "Source: " & _
|
|
' oErr.source & vbCrLf
|
|
' strMSG = strMSG & _
|
|
' "SQL State: " & _
|
|
' oErr.SQLState & vbCrLf
|
|
' strMSG = strMSG & _
|
|
' "Native Error: " & _
|
|
' oErr.NativeError & vbCrLf
|
|
' strMSG = strMSG & vbCrLf
|
|
' Next
|
|
'
|
|
' MsgBox strMSG
|
|
'End Sub
|
|
|
|
Public Sub ErrorHandler3(oConn2 As Connection)
|
|
Dim oErr As Error
|
|
Dim strMSG As String
|
|
|
|
For Each oErr In oConn2.Errors
|
|
strMSG = strMSG & _
|
|
"Error #: " & _
|
|
oErr.Number & vbCrLf
|
|
strMSG = strMSG & _
|
|
"Description: " & _
|
|
oErr.Description & vbCrLf
|
|
strMSG = strMSG & _
|
|
"Source: " & _
|
|
oErr.source & vbCrLf
|
|
strMSG = strMSG & _
|
|
"SQL State: " & _
|
|
oErr.SQLState & vbCrLf
|
|
strMSG = strMSG & _
|
|
"Native Error: " & _
|
|
oErr.NativeError & vbCrLf
|
|
strMSG = strMSG & vbCrLf
|
|
Next
|
|
|
|
MsgBox strMSG
|
|
End Sub
|
|
|
|
Public Sub AppQuit()
|
|
On Error Resume Next
|
|
|
|
If goConn.State = adStateOpen Then
|
|
goConn.Close
|
|
Set goConn = Nothing
|
|
End If
|
|
If goConn2.State = adStateOpen Then
|
|
goConn2.Close
|
|
Set goConn2 = Nothing
|
|
End If
|
|
|
|
|
|
End
|
|
End Sub
|
|
|
|
Public Function Str2Field(strValue As String) As Variant
|
|
If IsNull(strValue) Then
|
|
strValue = ""
|
|
If Trim$(strValue) = "" Then
|
|
Str2Field = Null
|
|
Else
|
|
Str2Field = strValue
|
|
End If
|
|
Else
|
|
If Trim$(strValue) = "" Then
|
|
Str2Field = Null
|
|
Else
|
|
Str2Field = strValue
|
|
End If
|
|
End If
|
|
End Function
|
|
Public Function Integer2Field(strValue As Variant) As Integer
|
|
' If strValue = "" Or strValue = " " Then
|
|
' If Trim$(strValue) = "" Then
|
|
' Integer2Field = 0
|
|
' Else
|
|
If IsNull(strValue) Then
|
|
Integer2Field = 0
|
|
ElseIf Trim$(strValue) = "" Then
|
|
Integer2Field = 0
|
|
Else
|
|
Integer2Field = CInt(strValue)
|
|
End If
|
|
' End If
|
|
|
|
End Function
|
|
|
|
Public Function Long2Field(strValue As Variant) As Integer
|
|
' If Trim$(strValue) = "" Then
|
|
' Long2Field = 0
|
|
' Else
|
|
If IsNull(strValue) Then
|
|
Long2Field = 0
|
|
ElseIf Trim$(strValue) = "" Then
|
|
Long2Field = 0
|
|
Else
|
|
Long2Field = CLng(strValue)
|
|
End If
|
|
' End If
|
|
|
|
End Function
|
|
|
|
Public Function Single2Field(strValue As Variant) As Single
|
|
' If Trim$(strValue) = "" Then
|
|
' Single2Field = 0
|
|
' Else
|
|
If IsNull(strValue) Then
|
|
Single2Field = 0
|
|
ElseIf Trim$(strValue) = "" Then
|
|
Single2Field = 0
|
|
Else
|
|
Single2Field = CSng(strValue)
|
|
End If
|
|
' End If
|
|
|
|
End Function
|
|
|
|
Public Function Date2Field(strValue As String) As Variant
|
|
If strValue = "" Then
|
|
Date2Field = Null
|
|
Else
|
|
If IsDate(strValue) Then
|
|
Date2Field = CDate(strValue)
|
|
Else
|
|
Date2Field = Null
|
|
End If
|
|
End If
|
|
End Function
|
|
|
|
Public Function Double2Field(strValue As String) As Variant
|
|
If IsNull(strValue) Then
|
|
Double2Field = 0
|
|
ElseIf Trim$(strValue) = "" Then
|
|
Double2Field = 0
|
|
Else
|
|
Double2Field = CDbl(strValue)
|
|
End If
|
|
' If strValue = "" Then
|
|
' Double2Field = Null
|
|
' Else
|
|
' If IsNumeric(strValue) Then
|
|
' Double2Field = CDbl(strValue)
|
|
' Else
|
|
' Double2Field = Null
|
|
' End If
|
|
' End If
|
|
End Function
|
|
|
|
Public Function Field2Str(vntField As Variant) As String
|
|
If IsNull(vntField) Then
|
|
Field2Str = ""
|
|
Else
|
|
Field2Str = Trim$(CStr(vntField))
|
|
End If
|
|
End Function
|
|
Public Function Field2Str2(vntField As Variant) As String
|
|
' If vntField = "" Then
|
|
' Field2Str2 = 0
|
|
' Else
|
|
If IsNull(vntField) Then
|
|
Field2Str2 = 0
|
|
ElseIf Trim$(vntField) = "" Then
|
|
Field2Str2 = 0
|
|
Else
|
|
Field2Str2 = Trim$(CStr(vntField))
|
|
End If
|
|
' End If
|
|
End Function
|
|
|
|
Public Function Field2Long(vntField As Variant) As Long
|
|
If IsNull(vntField) Then
|
|
Field2Long = -1
|
|
Else
|
|
Field2Long = CLng(vntField)
|
|
End If
|
|
End Function
|
|
|
|
Public Function Field2Double(vntField As Variant) As Long
|
|
' If Trim$(vntField) = "" Then
|
|
' Field2Double = 0
|
|
' Else
|
|
If IsNull(vntField) Then
|
|
Field2Double = 0
|
|
ElseIf Trim$(vntField) = "" Then
|
|
Field2Double = 0
|
|
Else
|
|
Field2Double = CDbl(vntField)
|
|
End If
|
|
' End If
|
|
End Function
|
|
|
|
Public Function Field2Decimal(vntField As Variant) As Long
|
|
' If Trim$(vntField) = "" Then
|
|
' Field2Decimal = 0
|
|
' Else
|
|
If IsNull(vntField) Then
|
|
Field2Decimal = 0
|
|
ElseIf Trim$(vntField) = "" Then
|
|
Field2Decimal = 0
|
|
Else
|
|
Field2Decimal = CDec(vntField)
|
|
End If
|
|
' End If
|
|
End Function
|
|
|
|
Public Function Field2Integer(vntField As Variant) As Long
|
|
' If Trim$(vntField) = "" Then
|
|
|
|
' Else
|
|
If IsNull(vntField) Then
|
|
Field2Integer = 0
|
|
ElseIf Trim$(vntField) = "" Then
|
|
Field2Integer = 0
|
|
Else
|
|
Field2Integer = CInt(vntField)
|
|
End If
|
|
' End If
|
|
End Function
|
|
|
|
Public Function Field2CheckBox(vntField As Variant) As Integer
|
|
If IsNull(vntField) Then
|
|
Field2CheckBox = vbUnchecked
|
|
Else
|
|
Field2CheckBox = IIf(vntField, vbChecked, vbUnchecked)
|
|
End If
|
|
End Function
|
|
|
|
Public Sub ListFindItem(ctlAny As Control, lngValue As Long)
|
|
Dim intLoop As Integer
|
|
Dim boolFound As Boolean
|
|
|
|
For intLoop = 0 To ctlAny.ListCount - 1
|
|
If ctlAny.ItemData(intLoop) = lngValue Then
|
|
ctlAny.ListIndex = intLoop
|
|
boolFound = True
|
|
intLoop = ctlAny.ListCount
|
|
End If
|
|
Next
|
|
|
|
If Not boolFound Then
|
|
ctlAny.ListIndex = -1
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub ListFindItem3(ctlAny As Control, lngValue As Long)
|
|
Dim intLoop As Integer
|
|
Dim boolFound As Boolean
|
|
|
|
For intLoop = 0 To ctlAny.ListCount - 1
|
|
If Field2Long(Left(ctlAny.ItemData(intLoop), 3)) = lngValue Then
|
|
ctlAny.ListIndex = intLoop
|
|
boolFound = True
|
|
intLoop = ctlAny.ListCount
|
|
End If
|
|
Next
|
|
|
|
If Not boolFound Then
|
|
ctlAny.ListIndex = -1
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub ListFindItem2(ctlAny As Control, lngValue As Long)
|
|
Dim intLoop As Integer
|
|
Dim boolFound As Boolean
|
|
|
|
For intLoop = 0 To ctlAny.ListCount - 1
|
|
If ctlAny.ItemData(intLoop) > lngValue Then
|
|
ctlAny.ListIndex = intLoop - 1
|
|
boolFound = True
|
|
intLoop = ctlAny.ListCount
|
|
End If
|
|
Next
|
|
|
|
If Not boolFound Then
|
|
ctlAny.ListIndex = -1
|
|
End If
|
|
End Sub
|
|
|
|
Public Function ListReposition(lstCtrl As Control, _
|
|
intINDEX As Integer) As Integer
|
|
If lstCtrl.ListCount = 0 Then
|
|
ListReposition = -1
|
|
Else
|
|
intINDEX = intINDEX + 1
|
|
|
|
If intINDEX >= lstCtrl.ListCount - 1 Then
|
|
ListReposition = lstCtrl.ListCount - 1
|
|
Else
|
|
intINDEX = intINDEX - 1
|
|
If intINDEX <= 0 Then
|
|
ListReposition = 0
|
|
Else
|
|
ListReposition = intINDEX
|
|
End If
|
|
End If
|
|
End If
|
|
End Function
|
|
Public Sub CBFindString(ctrControlName As Control, strFindStr As String)
|
|
|
|
Dim intLoop As Integer, strStr As String
|
|
|
|
For intLoop = 0 To ctrControlName.ListCount - 1
|
|
' strStr = ctrControlName.ItemData(intLoop)
|
|
strStr = ctrControlName.List(intLoop)
|
|
If Trim$(UCase$(strStr)) = Trim(UCase$(strFindStr)) Then
|
|
ctrControlName.ListIndex = intLoop
|
|
intLoop = ctrControlName.ListCount
|
|
' ctrControlName.SetFocus
|
|
Else
|
|
ctrControlName.ListIndex = -1
|
|
End If
|
|
Next intLoop
|
|
|
|
End Sub
|
|
|
|
Public Sub CBFindString3(ctrControlName As Control, strFindStr As String)
|
|
|
|
Dim intLoop As Integer, strStr As String
|
|
|
|
For intLoop = 0 To ctrControlName.ListCount - 1
|
|
' strStr = ctrControlName.ItemData(intLoop)
|
|
strStr = ctrControlName.List(intLoop)
|
|
If Left$(UCase$(strStr), 2) = Trim(UCase$(strFindStr)) Then
|
|
ctrControlName.ListIndex = intLoop
|
|
intLoop = ctrControlName.ListCount
|
|
' ctrControlName.SetFocus
|
|
Else
|
|
ctrControlName.ListIndex = -1
|
|
End If
|
|
Next intLoop
|
|
|
|
End Sub
|
|
|
|
Public Sub CBFindString1(ctrControlName As Control, strFindStr As String)
|
|
|
|
Dim intLoop As Integer, strStr As String
|
|
|
|
For intLoop = 0 To ctrControlName.ListCount - 1
|
|
' strStr = ctrControlName.ItemData(intLoop)
|
|
strStr = ctrControlName.List(intLoop)
|
|
If Left$(UCase$(strStr), 1) = Trim(UCase$(strFindStr)) Then
|
|
ctrControlName.ListIndex = intLoop
|
|
intLoop = ctrControlName.ListCount
|
|
' ctrControlName.SetFocus
|
|
Else
|
|
ctrControlName.ListIndex = -1
|
|
End If
|
|
Next intLoop
|
|
|
|
End Sub
|
|
|
|
Public Sub CBFindString4(ctrControlName As Control, strFindStr As String)
|
|
'This Routine will find something in the Item Data are of a control.
|
|
'This works best when looking for an amount that not just the list index number.
|
|
|
|
Dim intLoop As Integer, strStr As String
|
|
|
|
For intLoop = 0 To ctrControlName.ListCount - 1
|
|
strStr = ctrControlName.ItemData(intLoop)
|
|
If Left$(UCase$(strStr), 4) = Trim(UCase$(strFindStr)) Then
|
|
ctrControlName.ListIndex = intLoop
|
|
intLoop = ctrControlName.ListCount
|
|
ctrControlName.SetFocus
|
|
Else
|
|
ctrControlName.ListIndex = -1
|
|
End If
|
|
Next intLoop
|
|
|
|
End Sub
|
|
|
|
Public Sub CBFindString2(ctrControlName As Control, strFindStr As String)
|
|
|
|
Dim intLoop As Integer, strStr As String, strID As String
|
|
|
|
For intLoop = 0 To ctrControlName.ListCount - 1
|
|
' strStr = ctrControlName.ItemData(intLoop)
|
|
strStr = ctrControlName.List(intLoop)
|
|
strID = Left(Trim$(UCase$(strStr)), 3)
|
|
If Field2Str2(strID) = Trim(UCase$(strFindStr)) Then
|
|
' If Left(Trim$(UCase$(strStr)), 3) = Trim(UCase$(strFindStr)) Then
|
|
ctrControlName.ListIndex = intLoop
|
|
intLoop = ctrControlName.ListCount
|
|
ctrControlName.SetFocus
|
|
Exit Sub
|
|
Else
|
|
ctrControlName.ListIndex = -1
|
|
End If
|
|
Next intLoop
|
|
|
|
End Sub
|
|
|
|
Public Function FieldSelect(lstCtrl As Control)
|
|
lstCtrl.SelStart = 0
|
|
If lstCtrl.MaxLength > 0 Then
|
|
lstCtrl.SelLength = lstCtrl.MaxLength
|
|
Else
|
|
lstCtrl.SelLength = 1000
|
|
End If
|
|
End Function
|
|
|
|
Public Sub ErrorHandler2()
|
|
Set frmError.ErrorObj = Err
|
|
frmError.Show vbModal
|
|
End Sub
|
|
|
|
|
|
Public Function FindMax(ByVal strFILE As String, ByVal strField As String)
|
|
Dim strSQL As String, oRSMAX As Recordset
|
|
'Dim strField As String, strFile As String
|
|
|
|
strSQL = "SELECT Max(" & strField & ") as MAXField from " & strFILE 'tblOption"
|
|
Set oRSMAX = New Recordset
|
|
oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
|
|
|
|
FindMax = oRSMAX!maxfield
|
|
oRSMAX.Close
|
|
|
|
End Function
|