SpVoice

Sub SpVoice()
Dim lngVoiceCounter, tts
    'Dim tts As SpeechLib.SpVoice
    'Set tts = CreateObject("Sapi.SpVoice")
    'Dim vce As SpeechLib.SpObjectToken
    'C:\Program Files\Common Files\Microsoft Shared\Speech\sapi.dll
    'Microsoft Speech Object Library
    'SpeechLib.SpVoice
    'TypeName "SpVoice"
    'Const WAIT_INFINITE = -1
    'Const SVSFDefault = 0
    'Const SVSFlagsAsync = 1
    'Const SVSFPurgeBeforeSpeak = 2
    'Const SVSFIsFilename = 4
    'Const SVSFIsXML = 8
    'Const SVSFIsNotXML = 16
    On Error Resume Next
		Set wshShell = Wscript.CreateObject("Wscript.Shell") 
		strUserName = wshShell.ExpandEnvironmentStrings("%username%")    
    Set tts = Nothing
    Set tts = CreateObject("Sapi.SpVoice")
    If tts Is Nothing Then
        Status "FAILED Sapi.SpVoice creation"
    Else
         For lngVoiceCounter = 0 To tts.GetVoices.Count - 1
            Err.Clear
            Set tts.Voice = tts.GetVoices.Item(lngVoiceCounter)
            If Err.Number = 0 Then
                'Status "SUCCESS Sapi.SpVoice VOICE " & lngVoiceCounter & ": " & tts.GetVoices.Item(lngVoiceCounter).GetDescription
                'tts.Speak "Hello. I am S P Voice. This is voice number " & lngVoiceCounter & ", " & tts.GetVoices.Item(lngVoiceCounter).GetDescription, 1
                'tts.Speak "Yo " & strUserName & ". This is your computer speaking. My name is " & tts.GetVoices.Item(lngVoiceCounter).GetDescription, 1
								
								If Hour(Now) < 12 Then
									  intHour = Hour(Now)
									  intMinute = Minute(Now)
							  	  txtDayPart = ", A, M"
							  Else
							     intHour = Hour(Now) - 12
							     intMinute = Minute(Now)
							     txtDayPart = ", P, M"
							  End If
							tts.Speak "Heeear ye! Heear ye!"
							tts.Speak strUserName
							tts.speak "It, is, now "
							tts.speak intHour & ", " & intMinute & txtDayPart, 1
                While Not tts.WaitUntilDone(50)
                    Wscript.Sleep 100
                Wend
               
            End If
         Next
    End If
End Sub


Sub Status(strMessage)
    If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
        Wscript.Echo strMessage
    Else
        CreateObject("Wscript.Shell").Popup strMessage, 1 + (Len(strMessage)\20), "Status"
    End If
End Sub