UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Edit Discussion
> IS    
IS
Image:NotifCleanup.gif This page requires general cleanup in formatting or text to better fit the UA Wiki Guidelines
This page is under consideration for merging with: Function Library

Is (True) or NOT Is (False / Error) ?, Exists (True) or NOT Exists (False / Error) ?

Contents

[edit]

Is..


[edit]

IS_ToolBar

CODE

Public Function IS_ToolBar(cToolBarName As String, Optional bVBE As Boolean = False) As Boolean
On Error Resume Next
If bVBE Then
   IS_ToolBar = IsObject(Application.VBE.CommandBars(cToolBarName))
Else
   IS_ToolBar = IsObject(Application.CommandBars(cToolBarName))
End If
End Function


[edit]

IsNull or IS NULL ?


[edit]

IsProjectCompiled

CODE

? Application.IsCompiled


[edit]

Drive Exists


[edit]

Is Drive Ready

  • [[Startup#Verify Drive Is

Ready|Is Drive Ready]]


[edit]

Path/Folder Exists


[edit]

File Exists

CODE

' True=IS/Exists if **NOT** Hidden File
? (Len(Dir("D:\MyTestFile.txt"))>0)
? (Len(Dir("D:\MyTestFile.txt",vbHidden))>0) ' For Hidden File


[edit]

IsFileReadOnly

CODE

? ((GetAttr("D:\MyTestFile.txt") and vbReadOnly) = vbReadOnly)


[edit]

IsFileHidden

CODE

? ((GetAttr("D:\MyTestFile.txt") and vbHidden) = vbHidden)


[edit]

IsFileOld

CODE

Public Function IsFileOld(cFileName As String) As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim llRet As Boolean
   Const lkc_ProcName As String = "IsFileOld"
llRet = (DateDiff("d", FileDateTime(cFileName), Date) > 0)
LBL_xPAC_END:
       IsFileOld = llRet
   Exit Function
LBL_xPAC_ERR:
   MsgBox "Err: " & Err & "," & Err.Description & vbCrLf & _
           "FileName: " & cFileName, vbCritical, lkc_ProcName
       Resume LBL_xPAC_END
           Resume Next
           Resume
End Function


[edit]

IsFileOpen

CODE

Public Function IsFileOpen(cFullFileName As String) As Boolean
On Error Resume Next
   Dim ln_ff As Integer
ln_ff = FreeFile
Open (cFullFileName) For Binary Access Read Write Lock Read Write As ln_ff
Close ln_ff
LBL_xPAC_END:
   IsFileOpen = (Err = 70)
End Function

Example call:

CODE

? IsFileOpen("D:\Test.xls")


[edit]

IsStringAlphaOnly

IsAlphaOnly


[edit]

IsStringNumbersOnly

IsNumbersOnly


[edit]

IsStringEmpty

[edit]

IsStringValueEmpty

CODE

? (Len(Trim$(My_String_Variable_Name)) = 0)
? (Len(Trim$(My_Table/Query_Column_Name)) = 0)
? (Len(Trim$([My Table/Query Column Name])) = 0)
[edit]

IsVariantStringValueEmpty

CODE

' True=IS
? (Len(Trim$( Nz( My_String_Variable_Name))) = 0)
? (Len(Trim$( Nz( My_Table/Query_Column_Name))) = 0)
? (Len(Trim$( Nz( [My Table/Query Column Name]))) = 0)


[edit]

IsStringBlank

[edit]

IsStringValueBlank

CODE

' Possible, but **NOT** Recommended from Performance View
? (My_String_Variable_Name = "")
? (My_String_Variable_Name = vbNullString)
'-------------------------------------------------------------------------
' True=IS, Recommended, HIGH Performance
? (Len(My_String_Variable_Name) = 0)  
? (Len(My_Table/Query_Column_Name) = 0)
? (Len([My Table/Query Column Name]) = 0)
[edit]

IsVariantStringValueBlank

CODE

' Possible, but **NOT** Recommended from Performance View
? ( Nz( My_String_Variable_Name) = "")
? ( Nz( My_String_Variable_Name) = vbNullString)
'-------------------------------------------------------------------------
' True=IS, Recommended, HIGH Performance
? (Len( Nz( My_String_Variable_Name)) = 0)
? (Len( Nz( My_Table/Query_Column_Name)) = 0)
? (Len( Nz( [My Table/Query Column Name])) = 0)


[edit]

IsStringEqualTo

  • to declare the default comparison method in VBE_Menu,Module, use Keyword:
    • Option Compare >Compare-mode<
      • Binary (case-sensitive, DEFAULT)
      • Text (case-insensitive)
      • Database (based on locale ID of the database)}
CODE

? ("A"="a") ' Option Compare Binary (case-sensitive  ) , Result= False
? ("A"="a") ' Option Compare Text   (case-insensitive) , Result= True
? (UCase$(My_String_Variable_Name)=UCase$(My_String_Variable_Name)) ' (case-insensitive)
  • or use Keyword StrComp, to compare strings with HIGH-SPEED-PERFORMANCE
    • Do NOT use Keyword StrComp in Queries.
CODE

?(StrComp("ABC","abc",vbBinaryCompare)=0)'vbBinaryCompare,(case-sensitive),Result=False
?(StrComp("ABC","abc",vbTextCompare)=0)   'vbTextCompare, (case-insensitive),Result=True


[edit]

IsTable/TableExists

IsTable ( Ac_Menu,Table )


[edit]

IsQuery/QueryExists

IsQuery ( Ac_Menu,Query )


[edit]

IsMissingNumber

Find Missing Dates or Numbers within a Range


[edit]

IsMissingDate

Find Missing Dates or Numbers within a Range


[edit]

IsDatabaseOpenInExclusiveMode

CODE

? ((CurrentProject.Connection.Mode And adModeShareExclusive) = adModeShareExclusive)


[edit]

IsOfficeVersionEqualTo

CODE

? (val(Application.Version) = 10)    ' 10=Office.2002/XP, 11=Office.2003, ..


[edit]

IsCurrentStepOfRepeatForCounterEqualTo

CODE

For i = 1 To 100 Step 1
   If ((i Mod 5) = 0) Then ' Here: CurrentStepOfRepeatForCounterEqualTo=5
'i=0,-,-,-,-,5,-,-,-,-,10,--,--,--,--,15,..
   Else
'i=-,1,2,3,4,-,6,7,8,9,--,11,12,13,14,--,..
   End If
Next i


[edit]

Sys_AC_DatabasePropertyExists

CODE

Function Sys_AC_DatabasePropertyExists(cPropertyName As String) As Boolean
On Error Resume Next
Sys_AC_DatabasePropertyExists = _
   (True Or CurrentDb.Properties(cPropertyName).Inherited) And (Err = 0)
End Function


[edit]

IsDatabaseMDE

CODE

Function IsDatabaseMDE() As Boolean
On Error Resume Next
IsDatabaseMDE = _
   (True Or CurrentDb.Properties("MDE").Inherited) And (Err = 0)
End Function


[edit]

Sys_WIN_IsAppExcelRunning

CODE

Option Compare Database
Option Explicit
Private Declare Function _
   FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, _
               ByVal lpWindowName As String) As Long
Public Function Sys_WIN_IsAppExcelRunning(Optional bMsg As Boolean = False) As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim hWnd As Long, llRet As Boolean
   Const lc_ProcName As String = "Sys_WIN_IsAppExcelRunning"
hWnd = FindWindow("XLMAIN", vbNullString)
llRet = (hWnd > 0)
   If Not llRet And bMsg Then
MsgBox "Excel is **NOT** running..", vbInformation, lc_ProcName
   End If
LBL_xPAC_END:
       Sys_WIN_IsAppExcelRunning = llRet
   Exit Function
LBL_xPAC_ERR:
   MsgBox "Err: " & Err & "," & Err.Description, vbCritical, lc_ProcName
       Resume LBL_xPAC_END
           Resume Next
           Resume
End Function


[edit]

IsDatabaseObjectHidden

CODE

Public Function IsDatabaseObjectHidden(ObjectType As AcObjectType, _
   ObjectName As String) As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim llRet As Boolean
   Const lc_ProcName As String = "IsDatabaseObjectHidden"
If Len(ObjectName) = 0 Then
   Err.Raise 1111, lc_ProcName, "ObjectName is **EMPTY** !"
End If
llRet = GetHiddenAttribute(ObjectType:=ObjectType, ObjectName:=ObjectName) _
               And Not CBool(Application.GetOption("Show Hidden Objects"))
LBL_xPAC_END:
        IsDatabaseObjectHidden = llRet
   Exit Function
LBL_xPAC_ERR:
If Err = 2950 Then
   Resume Next
End If
   MsgBox "Err: " & Err & "," & Err.Description & vbCrLf & _
           "ObjectName: " & ObjectName & vbCrLf & _
           "ObjectType: " & ObjectType, vbCritical, lc_ProcName
       Resume LBL_xPAC_END
           Resume Next
           Resume
End Function


[edit]

IS_SubForm

CODE

Function IS_SubForm(Form As Access.Form) As Boolean
   On Error Resume Next
IS_SubForm = (Len(Form.Parent.Name) > 0) And (Err.Number = 0)
End Function

Example call:

CODE

Private Sub Form_Open(Cancel As Integer)
Dim ll_IAmSubform As Boolean
..
ll_IAmSubform = IS_SubForm (Me)
..
End Sub


[edit]

IsDatabaseObjectOpen

CODE

Function IsDatabaseObjectOpen(nObjType As AcObjectType, _
                               cObjectName As String) As Boolean
On Error GoTo LBL_xPAC_ERR
   Const lkc_ProcedureName = "IsDatabaseObjectOpen"
If (Len(cObjectName) = 0) Then
   Err.Raise 1111, lkc_ProcedureName, "ObjectName is **EMPTY** !"
End If
IsDatabaseObjectOpen = _
       ((SysCmd(acSysCmdGetObjectState, nObjType, cObjectName) _
           And acObjStateOpen) = acObjStateOpen)
LBL_xPAC_END:
   Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description & vbCrLf & _
       "ObjectName: " & cObjectName & vbCrLf & _
       "ObjType: " & nObjType, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
   Resume Next
   Resume
End Function

Example call: Is Form Form1 Open (IsFormOpen):

CODE

? IsDatabaseObjectOpen(acForm,"Form1")


[edit]

IsMissingDatabaseObject_Module

CODE

Function IsMissingDatabaseObject_Module() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Module"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = Application.CurrentProject.AllModules.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_Module = ll_Ret
   Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_DataAccessPage

CODE

Function IsMissingDatabaseObject_DataAccessPage() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_DataAccessPage"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = Application.CurrentProject.AllDataAccessPages.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_DataAccessPage = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_Form

CODE

Function IsMissingDatabaseObject_Form() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Form"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = Application.CurrentProject.AllForms.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_Form = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_Report

CODE

Function IsMissingDatabaseObject_Report() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Report"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = Application.CurrentProject.AllReports.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
        IsMissingDatabaseObject_Report = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_Macro

CODE

Function IsMissingDatabaseObject_Macro() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Macro"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = Application.CurrentProject.AllMacros.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_Macro = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_Query

CODE

Function IsMissingDatabaseObject_Query() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Query"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = CurrentDb.QueryDefs.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_Query = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_Table

CODE

Function IsMissingDatabaseObject_Table() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ln_ObjectCountCurrent As Long, ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_Table"
   Const lkn_ObjectCountRequired = 999 ' <--- Change Value for your Database -----
ln_ObjectCountCurrent = CurrentDb.TableDefs.Count
ll_Ret = (ln_ObjectCountCurrent <> lkn_ObjectCountRequired) Or (lkn_ObjectCountRequired = 0)
If ll_Ret Then
   MsgBox _
           "ObjectCount-Required= " & lkn_ObjectCountRequired & vbCrLf & _
           "ObjectCount-Current = " & ln_ObjectCountCurrent & vbCrLf & vbCrLf & _
           "DB: " & CurrentProject.FullName, _
           vbExclamation, lkc_ProcedureName
End If
LBL_xPAC_END:
       IsMissingDatabaseObject_Table = ll_Ret
  Exit Function
LBL_xPAC_ERR:
   MsgBox _
       "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
   Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsMissingDatabaseObject_All

CODE

Function IsMissingDatabaseObject_All() As Boolean
On Error GoTo LBL_xPAC_ERR
   Dim ll_Ret As Boolean
   Const lkc_ProcedureName = "IsMissingDatabaseObject_All"
ll_Ret = IsMissingDatabaseObject_DataAccessPage Or _
           IsMissingDatabaseObject_Form Or _
           IsMissingDatabaseObject_Report Or _
           IsMissingDatabaseObject_Macro Or _
           IsMissingDatabaseObject_Module Or _
           IsMissingDatabaseObject_Query Or _
           IsMissingDatabaseObject_Table
LBL_xPAC_END:
       IsMissingDatabaseObject_All = ll_Ret
  Exit Function
LBL_xPAC_ERR:
  MsgBox _
      "Err: " & Err & "," & Err.Description, vbCritical, lkc_ProcedureName
  Resume LBL_xPAC_END
       Resume Next
           Resume
End Function


[edit]

IsObject


[edit]

IsFunction1FasterThenFunction2

CODE

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub GetFuncSpeed()
Dim ln_Repeat As Long, ln_Time1 As Long, ln_Time2 As Long, i As Long
ln_Repeat = 100000
ln_Time1 = timeGetTime
For i = 1 To ln_Repeat
' call .......Tested Function1,2 here
Next i
ln_Time2 = timeGetTime
Debug.Print "Total-Time: " & (ln_Time2 - ln_Time1)
Debug.Print "One-Loop-Time: " & ((ln_Time2 - ln_Time1) / ln_Repeat)
End Sub


[edit]

IsTable1FasterThenTable2

Rushmorewith Table Index..


[edit]

Others

  • Or look at some other Links
Retrieved from "http://www.utteraccess.com/wiki/index.php/IS"
Edit Discussion
Thank you for your support!
This page has been accessed 14,066 times.  This page was last modified 00:47, 3 February 2012 by Jack Leach. Contributions by pacala_ba  Disclaimers