Lấy giọng đọc AI

tuhocvba

Administrator
Thành viên BQT
Mình đang dùng trang này để lấy giọng đọc, cũng như có thể download audio về.
Ai có cách khác thì giới thiệu nhé.
 

phuongnamhp92

Yêu THVBA
Xin chia sẻ với các bạn cách làm của tôi:
1. Thêm thư viện JsonConverter, tải từ github

2. Tạo 1 Zalo API (bản miễn phí có nhiều giới hạn)

3. Code để tải tệp âm thanh phát phát âm thanh
<Lưu ý thay thế API key >
Mã:
'Import Microsoft scripting runtime
#If VBA7 And Win64 Then
    Declare PtrSafe Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" _
                             (ByVal lpszSoundName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long
#Else
    Declare Function apiPlaySound Lib "winmm.dll" Alias "PlaySoundA" _
                     (ByVal lpszSoundName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#End If

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "URLMON" _
                                     Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
                                                                 ByVal szURL As String, ByVal szFileName As String, _
                                                                 ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long
#Else
    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
#End If

Public Sub Text_to_Audio()
    Dim input_text As String
    input_text = "Xin chao, toi ten la Nam"
    ConvertTextToSpeech input_text
End Sub

Private Sub ConvertTextToSpeech(input_text As String)
    Dim endpoint As String
    endpoint = "https://api.zalo.ai/v1/tts/synthesize"
    Dim api_key As String
    api_key = "API Key của bạn"

    Dim speaker_id As Integer
    speaker_id = 1
    Dim speed As Double
    speed = 0.8
    Dim quality As Integer
    quality = 0
    Dim encode_type As Integer
    encode_type = 0
    
    'Gửi yêu cầu tới API
    Dim xmlhttp As Object
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    xmlhttp.Open "POST", endpoint, False
    xmlhttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xmlhttp.SetRequestHeader "apikey", api_key
    xmlhttp.send "input=" & input_text & "&speaker_id=" & speaker_id & "&speed=" & speed & "&quality=" & quality & "&encode_type=" & encode_type
    
    'Xử lý kết quả trả về
    Dim response_text As String
    response_text = xmlhttp.responseText
    Set Json = JsonConverter.ParseJson(response_text)
    Dim audioURL As String
    audioURL = Json("data")("url")
    Dim saveAsPath As String: saveAsPath = "D:\test.wav"
      

    Dim IO As New FileSystemObject
Begin:
    DownloadAudioFile audioURL, saveAsPath
    Do While IO.FileExists(saveAsPath) = False
        GoTo Begin
    Loop
      
    PlayWindowsSound saveAsPath
    Kill saveAsPath
End Sub

Private Sub PlayWindowsSound(SoundFile As String)
    Const SND_FILENAME As Long = &H20000
    apiPlaySound SoundFile, 0, SND_FILENAME
End Sub

Private Sub DownloadAudioFile(audioURL As String, saveAsPath As String)
    URLDownloadToFile 0, audioURL, saveAsPath, 0, 0
End Sub
 
Top