MS Access FAQ - Modules

DoCmd OpenForm "frmFormName"
Do While IsFormLoaded("frmFormName")
  DoEvents
Loop

DoCmd OpenReport "rptReportName"
Do While IsReportLoaded("rptReportName")
  DoEvents
Loop

Function IsFormLoaded(pstrFormName As String) As Integer
  IsFormLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, A_FORM, pstrFormName)
End Function

Function IsReportLoaded(pstrReportName As String) As Integer
  IsReportLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, A_REPORT, pstrReportName)
End Function

For e = 1 to 9000
  Debug.Print e; " - "; Error(e)
Next

------- begin cut here -----------
Function RecordNumber (pstrPreFix As String, pfrm As Form) As String
    On Error GoTo RecordNumber_Err
    Dim rst As Recordset
    Dim lngNumRecords As Long
    Dim lngCurrentRecord As Long
    Dim strTmp As String
    
    Set rst = pfrm.recordsetclone
    rst.MoveLast
    rst.bookmark = pfrm.bookmark
    lngNumRecords = rst.recordcount
    lngCurrentRecord = rst.absoluteposition + 1
    strTmp = pstrPreFix & " " & lngCurrentRecord & " of " & lngNumRecords
RecordNumber_Exit:
    On Error Resume Next
    RecordNumber = strTmp
    rst.Close
    Set rst = Nothing
    Exit Function
RecordNumber_Err:
    Select Case Err
        Case 3021
            strTmp = "New Record"
            Resume RecordNumber_Exit
        Case Else
            strTmp = "#" & Error
            Resume RecordNumber_Exit
    End Select
End Function

(declarations)
Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer

(somewhere within a module)
Dim hModule as Integer

hModule = Shell("whatever.exe",1)
Do While GetModuleUsage(hModule)
  DoEvents
Loop
DoCmd Echo True, "This message will only come up when whatever.exe has finished"

Function Proper (var As Variant) As Variant
' Purpose: Convert the case of var so that the first letter of each word capitalized.

   Dim strV As String, intChar As Integer, i As Integer
   Dim fWasSpace As Integer    'Flag: was previous char a space?
   
   If IsNull(var) Then Exit Function
   strV = var
   fWasSpace = True              'Initialize to capitalize first letter.
   For i = 1 To Len(strV)
      intChar = Asc(Mid$(strV, i, 1))
      Select Case intChar
      Case 65 To 90              ' A to Z
         If Not fWasSpace Then Mid$(strV, i, 1) = Chr$(intChar Or &H20)
      Case 97 To 122             ' a to z
         If fWasSpace Then Mid$(strV, i, 1) = Chr$(intChar And &HDF)
      End Select
      fWasSpace = (intChar = 32)
   Next
   Proper = strV
End Function

Declare Function WNetGetUser Lib "user" (ByVal szUser As String, nBufferSize As Integer) As Integer
Function NetworkUserName () As String

   Dim iStringLength As Integer
   Dim sString As String * 255
   
   iStringLength = Len(sString)
   sString = String$(iStringLength, 0)

   If WNetGetUser(sString, iStringLength) = 0 Then
       NetworkUserName = Left$(sString, iStringLength)
   Else
       NetworkUserName = "Unknown"
   End If

End Function

(Declarations)
Option Explicit

Global gctlUnderMouse As Control

Function SetCtlUnderMouse(pctl As Control)
  Set gctlUnderMouse = pctl
End Function

Sub CreateSetCtlUnderMouse(pfrm As Form)
  Dim ctl As Control, i As Integer
  For i = 0 to pfrm.Count - 1
    Set ctl = pfrm(i)
    If ctl.InSelection Then
      ctl.OnMouseMove = "=SetCtlUnderMouse([" & ctl.Name & "])"
    End If
    Set ctl = Nothing
  Next
End Sub

Updated: 16/11/1997 - Trevor Best

Declare Function wu_GetUserName Lib "advapi32" Alias "GetUserNameA" _
                  (ByVal lpBuffer As String, nSize As Long) As Long

Function NetworkUserName () As String

   Dim lngStringLength As Long
   Dim sString As String * 255
   
   lngStringLength = Len(sString)
   sString = String$(lngStringLength, 0)

   If wu_GetUserName(sString, lngStringLength) Then
       NetworkUserName = Left$(sString, lngStringLength)
   Else
       NetworkUserName = "Unknown"
   End If

End Function

Sub Update_TempLib()

    On Error GoTo ErrorTrap
' Executing connect code at this point
    
Exit_errortrap:
    Exit Sub

ErrorTrap:

    Dim myerror As Error
    For Each myerror In DBEngine.Errors
    With myerror
        If .Number <> 3146 Then
        MsgBox .Description
        End If
    End With
    Next
    
    Resume Exit_errortrap
            
End Sub