Public Function WordCount01(ByRef sText As String) As Long
' by Chris Lucas, cdl1051@earthlink.net, 20011113
    Dim dest() As Byte
    Dim i As Long

    If LenB(sText) Then
        ' Move the string's byte array into dest()
        ReDim dest(LenB(sText))
        CopyMemory dest(0), ByVal StrPtr(sText), LenB(sText) - 1

        ' Now loop through the array and count the words
        For i = 0 To UBound(dest) Step 2
            If dest(i) > 32 Then
                 Do Until dest(i) < 33
                    i = i + 2
                 Loop
                 WordCount01 = WordCount01 + 1
            End If
        Next i
        Erase dest
    Else
        ' This is easy eh?
        WordCount01 = 0
    End If

End Function

Public Function WordCount02(ByRef sText As String) As Long
' by Chris Lucas, cdl1051@earthlink.net, 20011115
    Dim dest() As Byte
    Dim i As Long
    Dim tmpCount As Long
    
    If LenB(sText) Then
        ReDim dest(LenB(sText))
        CopyMemory dest(0), ByVal StrPtr(sText), LenB(sText) - 1
        For i = 0 To UBound(dest) Step 2
            If dest(i) > 32 Then
                Do Until dest(i) < 33
                   i = i + 2
                Loop
                tmpCount = tmpCount + 1
            End If
        Next i
        Erase dest
    End If
    WordCount02 = tmpCount
End Function

Public Function WordCount03(ByRef sText As String) As Long
' by Donald, donald@xbeat.net, 20011114
' based on WordCount01 by Chris
  Const cCharLow As Byte = 33
  Dim abText() As Byte
  Dim i As Long
  
  If LenB(sText) Then
    ReDim abText(LenB(sText))
    CopyMemory abText(0), ByVal StrPtr(sText), LenB(sText) - 1
    For i = 0 To UBound(abText) Step 2
      If abText(i) >= cCharLow Then
        Do
          i = i + 2
        Loop Until abText(i) < cCharLow
        WordCount03 = WordCount03 + 1
      End If
    Next
  End If

End Function

Public Function WordCount04(ByRef sText As String) As Long
' by Donald, donald@xbeat.net, 20011114
  Dim cCharLow As Byte: cCharLow = 33
  Dim abText() As Byte
  Dim i As Long
  
  If LenB(sText) Then
    ReDim abText(LenB(sText))
    CopyMemory abText(0), ByVal StrPtr(sText), LenB(sText) - 1
    For i = 0 To UBound(abText) Step 2
      If abText(i) >= cCharLow Then
        Do
          i = i + 2
        Loop Until abText(i) < cCharLow
        WordCount04 = WordCount04 + 1
      End If
    Next
  End If

End Function

Public Function WordCount05(ByRef sText As String) As Long
  ' by Paul - wpsjr1@syix.com, 20011117
  ' based on code from Don and Chris
  ' doping - string.tlb
  Dim a() As Byte
  Static b() As Byte
  Dim cCharLow As Byte: cCharLow = 33
  Dim lLen As Long
  Static lPrevLen As Long
  Dim i As Long
  
  lLen = LenB(sText)
  If lLen Then
    If lLen > 100 And lLen < 100000 Then
      ReDim a(lLen) ' faster to blindly redim than check
      CopyMemory a(0), ByVal StrPtr(sText), lLen
      For i = 0 To lLen - 1 Step 2
        If a(i) >= cCharLow Then
          Do
            i = i + 2
          Loop Until a(i) < cCharLow
          WordCount05 = WordCount05 + 1
        End If
      Next
    Else
      lLen = lLen \ 2
      If lPrevLen <> lLen Then ' only redim when necessary
        ReDim b(lLen)
        lPrevLen = lLen
      End If
      FastString.WideCharToMultiByte 0&, 0&, sText, lLen, b(0), lLen, 0&, 0&
      For i = 0 To lLen - 1
        If b(i) >= 33 Then
          Do
            i = i + 1
          Loop Until b(i) < 33
          WordCount05 = WordCount05 + 1
        End If
      Next
    End If
  End If
End Function

Public Static Function WordCount06(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011118
  Dim Chars() As Integer
  Dim SavePtr As Long    'Original Daten-Pointer
  Dim SADescrPtr As Long 'Safe Array Descriptor
  Dim DataPtr As Long    'pvData - Daten-Pointer
  Dim CountPtr As Long   'Pointer zu nElements
  Dim i As Long
  
  'Ggf. Integer-Array einrichten:
  If SavePtr = 0 Then
    ReDim Chars(1 To 1)
    SavePtr = VarPtr(Chars(1))
    PokeLng VarPtr(SADescrPtr), ByVal ArrPtr(Chars)
    DataPtr = SADescrPtr + 12
    CountPtr = SADescrPtr + 16
  End If
  
  'String durch Integer-Array mappen:
  PokeLng DataPtr, StrPtr(sText)
  PokeLng CountPtr, &H7FFFFFFF
  
  'Wörter zählen:
  For i = 1 To Len(sText)
    If Chars(i) > 32 Then
      WordCount06 = WordCount06 + 1
      Do
        i = i + 1
      Loop Until Chars(i) < 33
    End If
  Next i
  
  'Integer-Array restaurieren:
  PokeLng DataPtr, SavePtr
  PokeLng CountPtr, 1&
End Function

Public Static Function WordCount07(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011118
  Dim Chars() As Integer 'ASCII-Codes der Zeichen
  Dim Pointer As Long    'Safe Array Descriptor und co.
  Dim i As Long
  
  'Ggf. Integer-Array einrichten:
  If Pointer = 0 Then
    ReDim Chars(1 To 1)
    PokeLng VarPtr(Pointer), ByVal ArrPtr(Chars)
    PokeLng Pointer + 16, &H7FFFFFFF
    Pointer = Pointer + 12
  End If
  
  'String durch Integer-Array mappen:
  PokeLng Pointer, StrPtr(sText)
  
  'Wörter zählen:
  For i = 1 To Len(sText)
    If Chars(i) > 32 Then
      WordCount07 = WordCount07 + 1
      Do
        i = i + 1
      Loop Until Chars(i) < 33
    End If
  Next i
End Function

needs modSafeArray

Public Function WordCount08(ByRef sText As String) As Long
' by Paul - wpsjr1@syix.com, 20011119
  Dim lLen              As Long
  Dim lCounter          As Long
  Static saIn           As SAFEARRAYHEADER
  Static lArrayPointer  As Long
  Static iChar()        As Integer
  
  lLen = Len(sText)
  
  If lArrayPointer = 0 Then
    ReDim iChar(0)
    lArrayPointer = ArrPtr(iChar)
    With saIn
      .DataSize = 2
      .dimensions = 1
      .sab(0).cElements = &H7FFFFFFF
    End With
    RtlMoveMemory ByVal lArrayPointer, VarPtr(saIn), 4
    RtlMoveMemory lArrayPointer, ByVal lArrayPointer, 4
  End If
  
  ' refresh the pointer to the string data
  RtlMoveMemory ByVal lArrayPointer + 12, StrPtr(sText), 4

  If lLen Then
    lLen = lLen - 1
    Do
      If iChar(lCounter) > 32 Then
        WordCount08 = WordCount08 + 1
        Do
          lCounter = lCounter + 1
        Loop Until iChar(lCounter) < 33
      End If
      lCounter = lCounter + 1
    Loop While lCounter <= lLen
  End If
  
End Function

Public Function WordCount09(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011120
  Static Chars() As Integer 'Ascii-Codes der Zeichen
  Static Pointer As Long    'Safe Array Descriptor und co.
  Dim i As Long
  
  'Ggf. Integer-Array einrichten:
  If Pointer = 0& Then
    ReDim Chars(1& To 1&)
    PokeLng VarPtr(Pointer), ByVal ArrPtr(Chars)
    PokeLng Pointer + 16&, &H7FFFFFFF
    Pointer = Pointer + 12&
  End If
  
  'String durch Integer-Array mappen:
  PokeLng Pointer, StrPtr(sText)
  
  'Wörter zählen:
  For i = 1& To Len(sText)
    If Chars(i) > 32 Then
      WordCount09 = WordCount09 + 1&
      Do
        i = i + 1&
      Loop Until Chars(i) < 33
    End If
  Next i
End Function

Public Function WordCount10(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011122
  Static Chars() As Integer 'Ascii-Codes der Zeichen
  Static Pointer As Long    'Safe Array Descriptor und co.
  Static SavePtr As Long    'Original Array Data Pointer
  Dim i As Long
  
  'Ggf. Integer-Array einrichten:
  If Pointer = 0& Then
    ReDim Chars(1& To 1&)
    SavePtr = VarPtr(Chars(1))
    PokeLng VarPtr(Pointer), ByVal ArrPtr(Chars)
    PokeLng Pointer + 16&, &H7FFFFFFF
    Pointer = Pointer + 12&
  End If
  
  'String durch Integer-Array mappen:
  PokeLng Pointer, StrPtr(sText)
  
  'Wörter zählen:
  For i = 1& To Len(sText)
    If Chars(i) > 32 Then
      WordCount10 = WordCount10 + 1&
      Do
        i = i + 1&
      Loop Until Chars(i) < 33
    End If
  Next i
  
  'Integer-Array restaurieren, sonst ggf. GPF:
  PokeLng Pointer, SavePtr
End Function

It's a class:

' by Olaf Schmidt, os@datenhaus.de, 20011128
Option Explicit

Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)
Private Declare Function SysAllocStringByteLen& Lib "oleaut32" (ByVal olestr&, ByVal BLen&)

Private saSrcL&(5), SrcL&()


Private Sub Class_Initialize()
  saSrcL(0) = 1: saSrcL(1) = 4: saSrcL(4) = &H7FFFFFFF
  RtlMoveMemory ByVal ArrPtr(SrcL), VarPtr(saSrcL(0)), 4
End Sub


Friend Function WordCount(s$) As Long
Dim i&, SLen&, ub&: Static C32&, C32L&
  SLen = Len(s): If SLen = 0 Then Exit Function
  ub = (SLen - 1) \ 2
  saSrcL(3) = StrPtr(s): C32& = &H20: C32L& = &H20FFFF
  For i = 0 To ub
    If (SrcL(i) And &HFF&) > C32 Then
      WordCount = WordCount + 1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      Do
        If SrcL(i) <= C32L Then GoTo m2
        i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      Loop
    End If
m1: If SrcL(i) > C32L And i <= ub Then
      WordCount = WordCount + 1
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
      If SrcL(i) <= C32L Then GoTo m2
      Do
        i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1
        If SrcL(i) <= C32L Then GoTo m2
      Loop
    End If
m2: Next i
End Function


Private Sub Class_Terminate()
  RtlMoveMemory ByVal ArrPtr(SrcL), 0&, 4 'important
End Sub