set objVoice = CreateObject("SAPI.SpVoice")
set colVoice = objVoice.GetVoices() '获得语音引擎集合
objVoice.Volume = 100 '设置音量，0到100，数字越大音量越大

'得到所需语音引擎的编号
langCN = "MSSimplifiedChineseVoice" '简体中文
langEN = "MSSam" '如果安装了TTS Engines 5.1，还可以选择MSMike,MSMary
for i=0 to colVoice.count-1 
    if Right(colVoice(i).Id, len(langCN)) = langCN then cnVoice = i
    if Right(colVoice(i).Id, len(langEN)) = langEN then enVoice = i
next

'此函数用来检测是否为中文
function isChinese(word)
If Len(Hex(Asc(word))) > 2 Then
    isChinese = True
Else
    isChinese = False
End If
end function

strSource = "你真牛逼！ I 服了 you! " '测试文本
strDest = Mid(strSource, 1, 1)
strSelect = ""
splitKey = "/////" '设置对strSource按中文和英文进行分割的关键词，不要用strSource中出现的字词

'以下for语句功能是把strSource中的中英文用splitKey分开
For i = 2 To Len(strSource)
    strSelect = Mid(strSource, i, 1)
    If isChinese(strSelect) Then '如果是中文
        If isChinese(Right(strDest, 1)) Then '如果前一个字符是中文
            strDest = strDest & strSelect
        Else
            strDest = strDest & splitKey & strSelect
        End If
    Else
        If isChinese(Right(strDest, 1)) Then '前一个字符是中文
            strDest = strDest & splitKey & strSelect
        Else
            strDest = strDest & strSelect
        End If
    End If
Next

'将分开的strSource进行分组，并保存为数组形式
arrDest = Split(strDest, splitKey)

OK = True '设置OK为true的时候读中文
If isChinese(arrDest(0)) Then
    OK = True
Else
    OK = False
End If

'以下语句是逐组朗读
For Each p In arrDest
    If OK Then
        set objVoice.Voice = colVoice.Item(cnVoice) '设置语音引擎为简体中文
        objVoice.Speak(p)
        OK = False
    Else
        set objVoice.Voice = colVoice.Item(enVoice)
        objVoice.Speak(p)
        OK = True
    End If
Next
复制代码