Code After a Call to Form Unload will Prevent the Form from Closing

If you use control arrays to handle common button or menu activities, you might be tempted to make one of the buttons call the "Unload Me" event to end the form execution, as follows:

Private Sub cmdAction_Click(Index As Integer)
    '
    ' *** this doesn't work!
    '
    Select Case Index
        Case 0: Me.WindowState = vbMaximized
        Case 1: Me.WindowState = vbNormal
        Case 2: Unload Me
    End Select
    '
    MsgBox "Current state: " & CStr(Me.WindowState)
    '
End Sub

However, this code won't work. Since there's a line of executing code after the "Unload Me" statement, the form will hide, but never unload!

To fix this, you must replace the call to "Unload Me" with a flag variable and execute the "Unload Me" as the very last action in the method:

Private Sub cmdAction_Click(Index As Integer)
    '
    ' *** this works!
    '
    Dim blnUnload As Boolean
    '
    Select Case Index
        Case 0: Me.WindowState = vbMaximized
        Case 1: Me.WindowState = vbNormal
        Case 2: blnUnload = True
    End Select
    '
    MsgBox "Current state: " & CStr(Me.WindowState)
    '
    If blnUnload = True Then
        Unload Me
    End If
    '
End Sub

Be sure to Close all Data Objects upon Exit

If you use any data objects in your code (DAO, RDO, or ADO), you should be sure to explicitly close all open recordsets, databases, and workspaces before you exit. Even though the pointers to these objects are automatically destroyed when you exit the program, if you fail to explicitly close all open items, your database connections may not be immediately released and the memory used by these objects may never be re-allocated by the operating system.

Here's a short routine you can add to your Form_Unload event (or some other terminating code module) that will close all open DAO workspaces, databases, and recordsets and release the memory reserved by these objects. This code will work whether you have 1, 100, or even no connections open when you attempt to exit the form.

Private Sub Form_Unload(Cancel As Integer)
    '
    ' *** close out db objects
    ' *** and release all memory
    '
    On Error Resume Next
    '
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    '
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    '
End Sub

Sure-Fire Way to Allow Users to Cancel Form Unloads

There are a number of different ways a user can unload a form. Click the Exit button or menu item; click on the X in the upper-right corner of the form; select Close from the form window's pop-up menu in the upper-left corner; even cancel the program from the task manager or reboot the machine. The best way to give your users the power to cancel a form-unload activity, whatever its source, is to place all your form-unload checking code in the QueryUnload event of the form. This event fires no matter which
method is used to unload your form.

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '
    ' *** universal unload check
    '
    Dim strQuestion As String
    Dim intAnswer As Integer
    Dim aryMode As Variant
    '
    aryMode = Array("vbFormControlMenu", _
      "vbFormCode", "vbAppWindows", _
      "vbAppTaskManager", "vbFormMDIForm")
    '
    strQuestion = "Ready to unload this form?"
    '
    intAnswer = MsgBox(strQuestion, vbQuestion + vbYesNo, _
    aryMode(UnloadMode))
    If intAnswer = vbNo Then
        Cancel = -1
    End If
    '
End Sub

Labeling your forms

Do you have a ton of screens in your application? Do you also have plenty of users who want to "help you" by pointing out buttons that are one twip
out of place? Sometimes it's hard to know what screen users are talking about when they're trying to communicate a problem--particularly if they're
in a different location than you.
To reduce the pain of this process, I add a label (called lblHeader) to the top of each GUI window, nominally to hold start-up information for users when they first open the window. You can also use this label to hold the name of the window the user is looking at, by using the following code:

Private Sub Form_Load()
    SetupScreen me
End Sub

Public SetupScreen (frm as Form)
    ' Do other set-up stuff here (fonts, colors).
    HookInFormName frm
End Sub

Public Sub HookInFormName(frm As Form)
    ' The Resume Next on Error allows forms that do not use a standard
    ' header label to get past this.
    On Error Resume Next
    frm.lblHeader.Caption = "(" & frm.Name & ") " & frm.lblHeader.Caption
End Sub

Note that if you don't want to use a label, that you can also use code like

    frm.print frm.name

to print to the back of the window itself.

Importing Registry settings
You can use just a few lines of code to import Registry settings. If you have an application called myapp.exe and a Registry file called myapp.reg, the following code will put those settings into the Registry without bothering the user.

Dim strFile As String
strFile = App.Path & "\" & opts.AppExeName & ".reg"
If Len(Dir$(strFile)) > 1 Then
    lngRet = Shell("Regedit.exe /s " & strFile, vbNormalFocus)
End If

Quick Text Select On GotFocus

When working with data entry controls, the current value in the control often needs to be selected when the control received focus. This allows the user to immediately begin typing over any previous value. Here's a quick subroutine to do just that:

Public Sub FocusMe(ctlName As Control)
'
With ctlName
.SelStart = 0
.SelLength = Len(ctlName)
End With
'
End Sub

Now add a call to this subroutine in the GotFocus event of the input controls:

Private Sub txtFocusMe_GotFocus()
Call FocusMe(txtFocusMe)
End Sub

Using the Alias Option to Prevent API Crashes

A number of Windows APIs have parameters that can be more than one data type. For example, the WinHelp API call
can accept the last parameter as a Long or String data type depending on the service requested.

Visual Basic allows you to declare this data type as "Any" in the API call, but this can lead to type mismatch errors or
even system crashes if the value is not the proper form.

You can prevent the errors and improve the run-time type checking by declaring multiple versions of the same API function
in your program. By adding a function declaration for each possible parameter type, you can continue to use strong data type
checking. To illustrate this technique, add the following APIs and constants to a Visual Basic form. Notice that the two API
declarations differ only in their initial name ("WinHelp" and "WinHelpSearch") and the type declaration of the last parameter
("dwData as Long" and "dwData as String").

' WinHelp APIs
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal
wCommand As Long, ByVal dwData As Long) As Long
Private Declare Function WinHelpSearch Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal
wCommand As Long, ByVal dwData As String) As Long
'
Private Const HELP_PARTIALKEY = &H105&
Private Const HELP_HELPONHELP = &H4
Private Const HelpFile = "c:\program files\devstudio\vb5\help\vb5.hlp"

Now add two command buttons to your form (cmdHelpAbout and cmdHelpSearch) and place the following code behind the buttons.
Be sure to edit the location of the help file to match your installation of Visual Basic.

Private Sub cmdHelpAbout_Click()
'
WinHelp Me.hwnd, HelpFile, HELP_HELPONHELP, &H0
'
End Sub

Private Sub cmdHelpSearch_Click()
'
WinHelpSearch Me.hwnd, HelpFile, HELP_PARTIALKEY, "option"
'
End Sub

When you press on the HelpAbout button, you'll see help about using the help system.
When you press on the HelpSearch button, you'll see a list of help entries on the "option" topic.

Quick Custom Dialogs for DBGrid Cells

It's easy to add custom input dialogs to al the cells in the Microsoft Data Bound Grid control.

First, add a DBGrid control and Data control to your form. Next, set the DatabaseName and RecordSource properties of the data control to a valid
database and table ("biblio.mdb" and "Publishers" for example). Then set the DataSource property of the DBGrid control to Data1 (the data control).

Now add the following code to your form.

' general declaration area
Dim strDBGridCell As String


Private Sub DBGrid1_AfterColEdit(ByVal ColIndex As Integer)
'
DBGrid1.Columns(ColIndex) = strDBGridCell
'
End Sub

Private Sub DBGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
'
strDBGridCell = InputBox("Edit DBGrid Cell:", , DBGrid1.Columns(ColIndex))
'
End Sub

Now whenever you attempt to edit any cell in the DBGrid, you'll see the InputBox prompt you for input.
You can replace the InputBox with any other custom dialog you wish to build.

Creating a new context menu in editable controls

This routine will permit you to replace the original context menu with your private context menu in an editable control.

Add the following code to your form or to a BAS module:

Private Const WM_RBUTTONDOWN = &H204
Private 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 Sub OpenContextMenu(FormName As Form, MenuName As Menu)

'Tell system we did a right-click on the mdi
Call SendMessage(FormName.hwnd, WM_RBUTTONDOWN, 0, 0&)
'Show my context menu
FormName.PopupMenu MenuName
'
End Sub

Next, use the Visual Basic Menu Editor and the table below to create a simple menu.

Caption        Name         Visible
Context Menu    mnuContext    NO
...First Item    mnuContext1
...Second Item    mnuContext2

Note that the last two items in the menu are indented (...) one level and that only the first item in the list ("Context Menu")
has the Visible property set to NO.

Now add a text box to your form and enter the code below in the MouseDown event of the text box.

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = vbRightButton Then
Call OpenContextMenu(Me, Me.mnuContext)
End If

End Sub

Note: If you just want to kill the system context menu, just comment out the line:

FormName.PopupMenu MenuName

in the OpenContextMenu routine.

Simple file checking from anywhere

To keep my applications running smoothly, I often need to check that certain files exist.
So, I've written a simple routine to make sure they do. Here it is:

Public Sub VerifyFile(FileName As String)
'
On Error Resume Next
'Open a specified existing file
Open FileName For Input As #1
'Error handler generates error message with file and exits the routine
If Err Then
MsgBox ("The file " & FileName & " cannot be found.")
Exit Sub
End If
Close #1
'
End Sub

Now add a button to your form and place the code below behind the "Click" event.

Private Sub cmdVerify_Click()
'
Call VerifyFile("MyFile.txt")
'
End Sub

Manipulate your controls from the keyboard

If you're not comfortable using your mouse--or can't achieve the precise results you'd like--these tips will come in handy.

First, you can resize controls at design time by using the [Shift] and arrow keys, as follows:

SHIFT + RIGHT ARROW increases the width of the control
SHIFT + LEFT ARROW decreases the width of the control
SHIFT + DOWN ARROW increases the height of the control
SHIFT + UP ARROW decreases the height of the control

Note: The target control must have focus, so click on the control before manipulating it from the keyboard.

Second, by using the [Control] key and the arrow keys, you can move your controls at design time, as follows:

CONTROL + RIGHT ARROW to move the control to the right
CONTROL + LEFT ARROW to move the control to the left
CONTROL + DOWN ARROW to move the control downwards
CONTROL + UP ARROW to move the control upwards

If you select more than one control (by clicking on the first and shift-clicking on the others), the above procedures will affect all the selected controls.

Creating Win32 region windows

The Win32 API includes a really amazing feature called region windows. A window under Win32 no longer has to be rectangular! In fact,
it can be any shape that may be constructed using Win32 region functions.

Using the SetWindowRgn Win32 function from within VB is so simple, but the results are unbelievable!
The following example shows a VB form that is NOT rectangular!! Here is the code. Enjoy!

' This goes into the General Declarations section:

Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _ByVal Y2 As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _ByVal bRedraw As Boolean) As Long


Private Sub Form_Load()

Show 'The form!
SetWindowRgn hWnd, _
CreateEllipticRgn(0, 0, 300, 200), _
True

End Sub

Add Dithered Backgrounds to your VB Forms

Ever wonder how the SETUP.EXE screen gets its cool shaded background coloring? This color shading is called dithering, and you can easily
incorporate it into your forms. Add the following routine to a form:

Sub Dither(vForm As Form)
Dim intLoop As Integer
vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256
For intLoop = 0 To 255
vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), RGB(0, 0,
255 -intLoop), B
Next intLoop
End Sub

Now, add to the Form_Activate event the line

Dither ME

This version creates a fading blue background by adjusting the blue value in the RGB function. (RGB stands for Red-Green-Blue.) You can create a
fading red background by changing the RGB call to

RGB(255 - intLoop, 0, 0).

Confirm Screen Resolution

Here's a great way to stop the user from running your application in the wrong screen resolution. First, create a function called CheckRez:

Public Function CheckRez(pixelWidth As Long, pixelHeight As Long) As Boolean
'
Dim lngTwipsX As Long
Dim lngTwipsY As Long
'
' convert pixels to twips
lngTwipsX = pixelWidth * 15
lngTwipsY = pixelHeight * 15
'
' check against current settings
If lngTwipsX <> Screen.Width Then
CheckRez = False
Else
If lngTwipsY <> Screen.Height Then
CheckRez = False
Else
CheckRez = True
End If
End If
'
End Function

Next, run the following code at the start of the program:

If CheckRez(640, 480) = False Then
MsgBox "Incorrect screen size!"
Else
MsgBox "Screen Resolution Matches!"
End If

Use FreeFile to Prevent File Open Conflicts

Both Access and VB let you hard code the file numbers when using the File Open statement. For example:

Open "myfile.txt" for Append as #1
Print #1,"a line of text"
Close #1

The problem with this method of coding is that you never know which file numbers may be in use somewhere else in your program. If you attempt to use
a file number already occupied, you'll get a file error. To prevent this problem, you should always use the FreeFile function. This function will return the next available file number for your use. For example:

IntFile=FreeFile()
Open "myfile.txt" for Append as #intFile
Print #intFile,"a line of text"
Close #intFile

Measuring a text extent

It's very simple to determine the extent of a string in VB. You can do so with WinAPI functions, but there's an easier way: Use the AutoSize property
of a Label component. First, insert a label on a form (labMeasure) and set its AutoSize property to True and Visible property to False. Then write
this simple routine:

Private Function TextExtent(txt as String) as Integer
labMeasure.Caption = txt
TextExtent = labMeasure.Width
End Function

When you want to find out the extent of some text, simply call this function with the string as a parameter.

In my case it turned out that the measure was too short. I just added some blanks to the string. For example:

Private Function TextExtent(txt As String) As Integer
labMeasure.Caption = " " & txt
TextExtent = labMeasure.Width
End Function

Use ParamArray to Accept an Arbitrary Number of Parameters

You can use the ParamArray keyword in the declaration line of a method to create a subroutine or function that accepts an arbitrary number of parameters at runtime. For example, you can create a method that will fill a list box with some number of items even if you do not know the number of
items you will be sent. Add the method below to a form:

Public Sub FillList(ListControl As ListBox, ParamArray Items())
'
Dim i As Variant
'
With ListControl
.Clear
For Each i In Items
.AddItem i
Next
End With
'
End Sub

Note that the ParamArray keyword comes BEFORE the parameter in the declaration line. Now add a list box to your form and a command button. Add
the code below in the "Click" event of the command button.

Private Sub Command1_Click()
'
FillList List1, "TiffanyT", "MikeS", "RochesterNY"
'
End Sub

Use FileDSNs to ease ODBC Installs

If you're using an ODBC connection to your database, you can ease the process of installing the application on workstations by using the FileDSN
(data source name) instead of the more-common UserDSN. You define your ODBC connection as you normally would with UserDSNs. However, the resulting definition is not stored in the workstation registry. Instead it gets stored in a text file with the name of the DSN followed by ".dsn" (i.e.
"MyFileDSN.dsn").
The default folder for all FileDSNs is "c:\program files\common files\Odbc\data sources". Now, when you want to install the VB application that uses the FileDSN, all you need to do is add the FileDSN to the Install package and run the install as usual. No more setting up DSNs manually!

NOTE: FileDSNs are available with ODBC 3.0 and higher.

Increase Your RAD-ness by creating your own VB5 Templates

You can create your own VB Templates quickly and easily. If you find that you are adding the same routines to your forms, classes, BAS modules, etc.
you can build generic versions and place them in the Templates folder tree of VB5. By placing the coding module (frm, bas.cls, etc.) in the proper
subfolder of the Templates folder, you'll see the new item appear whenever you select the Add... dialog box. You can add as many controls, library
references, and lines of code as you wish to the templates.

CAUTION: If you uninstall VB5, you may loose your Templates folder and all its contents. Be sure to keep a secured copy of all your template files in
a safe location.

Opening a browser to your homepage

You can use code like the following to open a browser to your homepage.
Modify filenames, paths, and URLs as necessary to match the values on your system.

Dim FileName As String, Dummy As String
Dim BrowserExec As String * 255
Dim RetVal As Long
Dim FileNumber As Integer
Const SW_SHOWNORMAL = 1 ' Restores Window if Minimized or

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As _
String) As Long
'<Code> ---------

BrowserExec = Space(255)
FileName = "C:\temphtm.HTM"

FileNumber = FreeFile() ' Get unused file number

Open FileName For Output As #FileNumber ' Create temp HTML file
Write #FileNumber, "<HTML> <\HTML>" ' Output text
Close #FileNumber ' Close file

' Then find the application associated with it.
RetVal = FindExecutable(FileName, Dummy, BrowserExec)
BrowserExec = Trim$(BrowserExec)
' If an application is found, launch it!
If RetVal <= 32 Or IsEmpty(BrowserExec) Then ' Error

Msgbox "Could not find a browser"

Else
RetVal = ShellExecute(frmMain.hwnd, "open", BrowserExec, _
"www.myurl.com", Dummy, SW_SHOWNORMAL)
If RetVal <= 32 Then ' Error
Msgbox "Web Page not Opened"
End If
End If

Kill FileName ' delete temp HTML file

A function for numbers beginning with 0

Here is a function that is very helpful when you need some number that begins with 0's and has to be a certain number of digits:

Function PadToString(intValue, intDigits)
PadToString = String(intDigits - Len(intValue), "0") & intValue
End Function

Usage:
myNewStr = PadToString(702, 6)

myNewStr would be "000702"

Convert NULL values to empty strings to avoid errors

When retrieving NULL values from a recordset object, errors can occur. One way to avoid this is to inspect the value of the field, and if it's NULL, convert it to an empty string or zero. For example:

If isnull(rs("Field")) then tmp="" else tmp=rs("Field")
form.textfield=tmp

An even simpler way is to use the format function, which will convert a NULL value to an empty string automatically, avoiding any error messages. It will look like this:

form.textfield=format(rs("Field"))

Creating professional documents with code

Have you ever wanted to create polished, professional documents, like those created in Microsoft Word, through the use of code? Follow these easy steps to make it happen:

1.)  Add a reference to your project for "Microsoft Word 8.0 Object Library" (MSWORD8.OLB).

2.)  Add the following code to create an instance of Word and add text to a new document:

Dim objWord As New Word.Application

'-- Show Microsoft Word
objWord.Visible = True

'-- Add new Document
objWord.Documents.Add

'-- Add text to Document
objWord.Selection.TypeText "Visual Basic!"

'-- Select all Text
objWord.Selection.WholeStory

'-- Change Font Size
objWord.Selection.Font.Size = 50

Set objWord = Nothing

3.)  Be sure to check out the Object Browser for more properties and methods exposed by the Word Object.

Launch your default web browser from a VB app

Here is a nice function to launch the default web browser from a VB application.

Add the following code to the general section of a module:

Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWDEFAULT As Long = 10

Add the following code to a form, which spawns off the default browser:

Public Sub RunBrowser(strURL As String, iWindowStyle As Integer)
Dim lSuccess As Long

'-- Shell to default browser
lSuccess = ShellExecute(Me.hwnd, "Open", strURL, 0&, 0&, iWindowStyle)
End Sub

To launch the VBCE.com web site, use the following function call:
Call RunBrowser ("www.vbce.com", SW_SHOWNORMAL)

Tip for finding a leap year

Here is a nice function for finding a leap year.  The trick is to not only dividing the year by 4, but also test for division by 100 and 400.

Public Function IsLeapYear(iYear As Integer)
    '-- Check for leap year
    If (iYear Mod 4 = 0) And _
    ((iYear Mod 100 <> 0) Or (iYear Mod 400 = 0)) Then
        IsLeapYear = True
    Else
        IsLeapYear = False
    End If
End Function

Using the Base Address for In-Process Components to speed up the loading phase

When you create an in-process component and load it in your Visual Basic application, the process loads at a base address in memory.

How can you change the Base Address of your In-Process Component?
To enter the base address for your component, open the Project Properties dialog box and select the Compile tab. The address is entered in the DLL Base Address box as an unsigned decimal or hexadecimal integer.
The default value is &H11000000 (285,212,672). If you neglect to change this value, your component will conflict with every other in-process component compiled using the default. Staying well away from this address is recommended.

Choose a base address between 16 megabytes (16,777,216 or &H1000000) and two gigabytes (2,147,483,648 or &H80000000). The base address must be a multiple of 64K. The memory used by your component begins at the initial
base address and is the size of the compiled file, rounded up to the next multiple of 64K.

Your program cannot extend above two gigabytes, so the maximum base address is actually two gigabytes minus the memory used by your component. Executables will usually load at the 4 megabyte logical address. The region below 4 megabytes is reserved under Windows 95, and regions above two gigabytes are reserved by both Windows 95 and Windows NT.

A good way to make sure all your components have a different base address is to keep track of all them, and create a random selective tool to create new unique base addresses. This way your components will not conflict with each other.

Using the Win32 API to write to the NT EventLog

Recently a tip went out that showed you how to write to the NT EventLog using the App object.  This method has 2 limitations:

1) You cannot use the code during a debug session.
2) The source entry in the Event Log is always VBRuntime

Using the Win32 API alleviates these problems.  Enter the following code in the General Declarations of a module:

    Declare Function RegisterEventSource Lib "advapi32.dll" Alias _
        "RegisterEventSourceA" (ByVal lpUNCServerName As String, _
        ByVal lpSourceName As String) As Long

    Declare Function DeregisterEventSource Lib "advapi32.dll" ( _
        ByVal hEventLog As Long) As Long

    Declare Function ReportEvent Lib "advapi32.dll" Alias _
      "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Integer, _
        ByVal wCategory As Integer, ByVal dwEventID As Long, _
        ByVal lpUserSid As Any, ByVal wNumStrings As Integer, _
        ByVal dwDataSize As Long, plpStrings As Long, _
        lpRawData As Any) As Boolean

    Declare Function GetLastError Lib "kernel32" () As Long

    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        hpvDest As Any, hpvSource As Any, _
        ByVal cbCopy As Long)

    Declare Function GlobalAlloc Lib "kernel32" ( _
         ByVal wFlags As Long, _
         ByVal dwBytes As Long) As Long

    Declare Function GlobalFree Lib "kernel32" ( _
         ByVal hMem As Long) As Long

    '-- Public Constants
    Public Const EVENTLOG_SUCCESS = 0
    Public Const EVENTLOG_ERROR_TYPE = 1
    Public Const EVENTLOG_WARNING_TYPE = 2
    Public Const EVENTLOG_INFORMATION_TYPE = 4
    Public Const EVENTLOG_AUDIT_SUCCESS = 8
    Public Const EVENTLOG_AUDIT_FAILURE = 10

Public Function WriteToEventLog(sMessage As String, _
                           sSource As String, _
                           iLogType As Integer, _
                           vEventID As Integer) As Boolean

    Dim bRC              As Boolean
    Dim iNumStrings      As Integer
    Dim hEventLog        As Long
    Dim hMsgs            As Long
    Dim cbStringSize     As Long
    Dim iEventID         As Integer

    hEventLog = RegisterEventSource("", sSource)
    cbStringSize = Len(sMessage) + 1
    hMsgs = GlobalAlloc(&H40, cbStringSize)
    CopyMemory ByVal hMsgs, ByVal sMessage, cbStringSize
    iNumStrings = 1

    '-- ReportEvent returns 0 if failed,
    '-- Any other number indicates success
    If ReportEvent(hEventLog, _
       iLogType, 0, _
       iEventID, 0&, _
       iNumStrings, cbStringSize, _
       hMsgs, hMsgs) = 0 Then
        '-- Failed
        WriteToEventLog = False
    Else
        '-- Sucessful
        WriteToEventLog = True
    End If

    Call GlobalFree(hMsgs)
    DeregisterEventSource (hEventLog)
End Function

An example of how to write to the NT EventLog:

Call WriteToEventLog("Warning, file exceeded recommended limit.", _
"Test App", _
EVENTLOG_WARNING_TYPE, 1003)

Legal Disclaimer
THE INFORMATION IN THIS PUBLICATION IS PROVIDED "AS IS". WE EXPRESSLY DISCLAIMS ALL REPRESENTATIONS AND WARRANTIES OF ANY KIND REGARDING THE CONTENTS OR USE OF THE INFORMATION INCLUDING, BUT NOT LIMITED TO, EXPRESS AND IMPLIED WARRANTIES OF ACCURACY, COMPLETENESS, MERCHANTABILITY, FITNESS FOR A PARTICULAR USE, OR NON-INFRINGEMENT. IN NO EVENT SHALL WE BE LIABLE FOR ANY DIRECT, INDIRECT, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES, INCLUDING LOST PROFITS, LOST BUSINESS OR LOST DATA, RESULTING FROM THE USE OR RELIANCE UPON THE INFORMATION, EVEN IF WE HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF IMPLIED WARRANTIES, SO THE ABOVE EXCLUSION MAY NOT APPLY TO YOU.