On Error Resume Next TextToSpeech TextToSpeech1 VoiceText VoiceText1 ActiveVoice ActiveVoice1 SpVoice MsgBox "Done" Sub VoiceText() Dim tts 'Dim tts As VTxtAuto.VTxtAuto 'Set tts = CreateObject("Speech.VoiceText") 'C:\WINNT\speech\vcmd.exe 'C:\WINNT\Speech\vtxtAuto.tlb 'Voice Text Object Library 'Voice Text 1.0 Type Library 'TypeName "IVTxtAuto" 'Const vtxtst_STATEMENT = 1 'Const vtxtst_QUESTION = 2 'Const vtxtst_COMMAND = 4 'Const vtxtst_WARNING = 8 'Const vtxtst_READING = 16 'Const vtxtst_NUMBERS = 32 'Const vtxtst_SPREADSHEET = 64 On Error Resume Next Set tts = Nothing Set tts = CreateObject("Speech.VoiceText") If tts Is Nothing Then Status "FAILED Speech.VoiceText creation" Else tts.Register "", " " Err.Clear tts.Enabled = True If Err.Number = 0 Then Status "SUCCESS Speech.VoiceText" tts.Speak "Hello, I am Speech Voice Text.", 16 While tts.IsSpeaking Wscript.Sleep 100 Wend Else Status "FAILED Speech.VoiceText automation" End If End If End Sub Sub VoiceText1() Dim tts 'Dim tts As VTxtAuto.VTxtAuto 'Set tts = CreateObject("Speech.VoiceText.1") 'C:\WINNT\speech\vcmd.exe 'C:\WINNT\Speech\vtxtAuto.tlb 'Voice Text Object Library 'Voice Text 1.0 Type Library 'TypeName "IVTxtAuto" 'Const vtxtst_STATEMENT = 1 'Const vtxtst_QUESTION = 2 'Const vtxtst_COMMAND = 4 'Const vtxtst_WARNING = 8 'Const vtxtst_READING = 16 'Const vtxtst_NUMBERS = 32 'Const vtxtst_SPREADSHEET = 64 On Error Resume Next Set tts = Nothing Set tts = CreateObject("Speech.VoiceText.1") If tts Is Nothing Then Status "FAILED Speech.VoiceText.1 creation" Else tts.Register "", " " Err.Clear tts.Enabled = True If Err.Number = 0 Then Status "SUCCESS Speech.VoiceText.1" tts.Speak "Hello, I am Speech Voice Text 1.", 16 While tts.IsSpeaking Wscript.Sleep 100 Wend Else Status "FAILED Speech.VoiceText.1 automation" End If End If End Sub Sub ActiveVoice() Dim lngVoiceCounter, tts 'Dim tts As ACTIVEVOICEPROJECTLib.DirectSS 'Set tts = CreateObject("ActiveVoice.ActiveVoice") 'C:\WINNT\Speech\Xvoice.dll 'Microsoft Direct Speech Synthesis 'Microsoft Direct Text-To-Speech 'TypeName "DirectSS" On Error Resume Next Set tts = Nothing Set tts = CreateObject("ActiveVoice.ActiveVoice") If tts Is Nothing Then Status "FAILED ActiveVoice.ActiveVoice creation" Else For lngVoiceCounter = 1 To tts.CountEngines Err.Clear tts.Select (lngVoiceCounter) If Err.Number = 0 Then Status "SUCCESS ActiveVoice.ActiveVoice VOICE " & lngVoiceCounter & ": " & tts.ModeName(lngVoiceCounter) tts.Speak "Hello, I am Active Voice. This is voice number " & lngVoiceCounter & ", " & tts.ModeName(lngVoiceCounter) While tts.Speaking Wscript.Sleep 100 Wend End If Next End If End Sub Sub ActiveVoice1() Dim lngVoiceCounter, tts 'Dim tts As ACTIVEVOICEPROJECTLib.DirectSS 'Set tts = CreateObject("ActiveVoice.ActiveVoice.1") 'C:\WINNT\Speech\Xvoice.dll 'Microsoft Direct Speech Synthesis 'Microsoft Direct Text-To-Speech 'TypeName "DirectSS" On Error Resume Next Set tts = Nothing Set tts = CreateObject("ActiveVoice.ActiveVoice.1") If tts Is Nothing Then Status "FAILED ActiveVoice.ActiveVoice.1 creation" Else For lngVoiceCounter = 1 To tts.CountEngines Err.Clear tts.Select (lngVoiceCounter) If Err.Number = 0 Then Status "SUCCESS ActiveVoice.ActiveVoice.1 VOICE " & lngVoiceCounter & ": " & tts.ModeName(lngVoiceCounter) tts.Speak "Hello, I am Active Voice 1. This is voice number " & lngVoiceCounter & ", " & tts.ModeName(lngVoiceCounter) While tts.Speaking Wscript.Sleep 100 Wend End If Next End If End Sub Sub TextToSpeech() Dim lngVoiceCounter, tts 'Dim tts As HTTSLib.TextToSpeech 'Set tts = CreateObject("TextToSpeech.TextToSpeech") 'C:\WINNT\Speech\vtext.dll 'Microsoft Voice Text 'HttsLib.TextToSpeech 'TypeName "TextToSpeech" On Error Resume Next Set tts = Nothing Set tts = CreateObject("TextToSpeech.TextToSpeech") If tts Is Nothing Then Status "FAILED TextToSpeech.TextToSpeech creation" Else For lngVoiceCounter = 1 To tts.CountEngines Err.Clear tts.Select (lngVoiceCounter) If Err.Number = 0 Then Status "SUCCESS TextToSpeech.TextToSpeech VOICE " & lngVoiceCounter & ": " & tts.ModeName(lngVoiceCounter) tts.Speak "Hello, I am Text To Speech. This is voice number " & lngVoiceCounter & ", " & tts.ModeName(lngVoiceCounter) While tts.IsSpeaking Wscript.Sleep 100 Wend End If Next End If End Sub Sub TextToSpeech1() Dim lngVoiceCounter, tts 'Dim tts As HTTSLib.TextToSpeech 'Set tts = CreateObject("TextToSpeech.TextToSpeech.1") 'C:\WINNT\Speech\vtext.dll 'Microsoft Voice Text 'HttsLib.TextToSpeech 'TypeName "TextToSpeech" On Error Resume Next Set tts = Nothing Set tts = CreateObject("TextToSpeech.TextToSpeech.1") If tts Is Nothing Then Status "FAILED TextToSpeech.TextToSpeech.1 creation" Else For lngVoiceCounter = 1 To tts.CountEngines Err.Clear tts.Select (lngVoiceCounter) If Err.Number = 0 Then Status "SUCCESS TextToSpeech.TextToSpeech.1 VOICE " & lngVoiceCounter & ": " & tts.ModeName(lngVoiceCounter) tts.Speak "Hello, I am Text To Speech 1. This is voice number " & lngVoiceCounter & ", " & tts.ModeName(lngVoiceCounter) While tts.IsSpeaking Wscript.Sleep 100 Wend End If Next End If End Sub 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 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 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