Hola, modifique la función para que lea texto mas largos, lo que hice fue partir el texto separando por "," y "." en caso de que estos no existan por espacio.
no es super fluido la pronunciación pero safa bastante.
También con el api mciSendString es asíncrona aproveche esta ventaja para ir descargando y reproduciendo.
Option Explicit
'-----------------------------------------------------------------------------------------------------
'Autor: Leandro Ascierto
'Web: www.leandroascierto.com.ar
'Abreviaturas
'de, da, es, fi, fr, en, it, nl, pl, pt, sv"
'Alemán , Danés, Español, Finlandia, Francés, Inglés, Italiano, Neerlandés, Polaco, Portugués, Sueco
'----------------------------------------------------------------------------------------------------
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function GoogleSpeak(ByVal sText As String, Optional ByVal Language As String = "es", Optional ByVal bDoevents As Boolean) As Boolean
On Error Resume Next
Dim sTempPath As String, ml As String
Dim cText As Collection
Dim cPaths As Collection
Dim i As Long
Dim bStatePlay As Boolean
Dim lTrackCount As Long
Dim lTrack As Long
Dim FileLength As Long
Set cPaths = New Collection
Set cText = New Collection
sText = Replace(sText, vbCrLf, " ")
Do While Len(sText)
cText.Add MySplit(sText)
Loop
lTrackCount = cText.Count
For i = 1 To cText.Count
cPaths.Add Environ("Temp") & "\TempMP3.MP3" & i
Next
lTrack = 1
ml = String(30, 0)
For i = 1 To cText.Count
If URLDownloadToFile(0&, "http://translate.google.com/translate_tts?tl=" & Language & "&q=" & cText.Item(i), cPaths.Item(i), 0&, 0&) = 0 Then
If mciSendString("status myfile position ", ml, 30, 0&) = 0 Then
If Val(ml) = FileLength Then
Call mciSendString("close myfile", 0&, 0&, 0&)
Kill cPaths.Item(lTrack)
lTrack = lTrack + 1
FileLength = PlaySound(cPaths.Item(lTrack))
End If
Else
FileLength = PlaySound(cPaths.Item(lTrack))
End If
If bDoevents Then DoEvents
End If
Next
Do
If mciSendString("status myfile position ", ml, 30, 0&) = 0 Then
If Val(ml) = FileLength Then
Call mciSendString("close myfile", 0&, 0&, 0&)
Kill cPaths.Item(lTrack)
lTrack = lTrack + 1
If lTrack <= lTrackCount Then
FileLength = PlaySound(cPaths.Item(lTrack))
If FileLength = 0 Then Exit Do
End If
End If
Else
Exit Do
End If
If bDoevents Then DoEvents
Loop
End Function
Private Function PlaySound(ByVal sTempPath As String) As Long
Dim ml As String
Dim FileLength As Long
If mciSendString("open " & Chr$(34) & sTempPath & Chr$(34) & " type MpegVideo" & " alias myfile", 0&, 0&, 0&) = 0 Then
ml = String(30, 0)
Call mciSendString("status myfile length ", ml, 30, 0&)
FileLength = Val(ml)
If FileLength Then
If mciSendString("play myFile", 0&, 0&, 0&) = 0 Then
PlaySound = FileLength
Else
PlaySound = 0
End If
End If
End If
End Function
Private Function MySplit(sText As String) As String
Dim lPos As Long
Dim lPos1 As Long
Dim lPos2 As Long
If Len(sText) > 100 Then
lPos1 = InStrRev(sText, ". ", 100)
lPos2 = InStrRev(sText, ", ", 100)
lPos = IIf(lPos1 > lPos2, lPos1, lPos2)
If lPos = 0 Then lPos = InStrRev(sText, " ", 100)
MySplit = Left$(sText, lPos)
sText = Mid$(sText, lPos + 1)
Else
MySplit = sText
sText = vbNullString
End If
End Function
Private Sub Command1_Click()
Call GoogleSpeak(Text1, "es", True)
End Sub
No lo testie al 100% pero bueno cualquier cuelgue abría que depurarlo para ver si ocurrió algo imprevisto.
