Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err
Option Compare Database
Option Explicit
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserName" (ByVal lpBuffer As String, nSize As Long) As Long
Dim lngLen As Long
Dim lngX As Long
Dim strUserName As String
strUserName = String$(254, 0&)
lngLen = 255&
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0&) Then
strUserName = Left$(strUserName, lngLen - 1&)
End If
If strUserName <> vbNullString Then
GetNetworkUserName = strUserName
Else
GetNetworkUserName = "{unknown}"
End If
Dim tmpDB As DAO.Database, qry As DAO.QueryDef
Set tmpDB = CurrentDb
Combo99.Value = ""
Combo89.Value = ""
Combo71.Value = ""
Combo55.Value = ""
Combo85.Value = ""
Combo212.Value = ""
For Each qry In CurrentDb.QueryDefs
DoCmd.Close acQuery, qry.Name, acSaveYes
Dim intCount As Integer
intCount = 0
If DCount("Location", "Phone numbers Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "", acViewNormal, acReadOnly
End If
If DCount("Alias", "SD Documentation Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
End If
If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
End If
If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
End If
If DCount("[IP Address]", "Xerox IP Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
End If
If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
intCount = intCount + 1
DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
End If
If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"
tmpDB.Execute "INSERT INTO [Usage Log]([NT ID], loginDate) VALUES(" & Chr(34) & GetNetworkUserName() & Chr(34) & ", " & CDbl(Now) & ")"
cmdFind_Click_Exit:
tmpDB = Nothing
Exit Sub
cmdFind_Click_Err:
MsgBox Error$
Resume cmdFind_Click_Exit
End Sub