Translating Subtitles

[keyboard]

Hello,
I am trying to translate an English subtitle into Hebrew.
Until some time ago, there is a site I could upload the file
and get it translated fine. Since it was updated, it makes a mess
- missing lines, breaking lines.
I also tried to open the subtitle into Google Chrome, translate, select all, copy and paste into notepad,
Renamed to ...srt file, bad results.
Any other idea, please ?
Answers will be appreciated.
Thanks
Motim

[Anonymous84]

--

[pchan]

I butchered an Excel VBA using IE to Excel VBA using Chrome Selenium basic. Why I choose Chrome? Using full Xpath will go direct to the result and it's the easiest.

Things to be done before running Excel macro.
Get installer here.
https://github.com/florentbr/SeleniumBasic/releases/download/v2.0.9.0/SeleniumBasic-2.0.9.0.exe

Get latest Chromedriver.exe and replace the old one here.
https://googlechromelabs.github.io/chrome-for-testing/

Use this guide.
https://stackoverflow.com/questions/57216623/using-google-chrome-in-selenium-vba-installation-steps
Step 4 and 5 must be completed in order for the Excel macro to run.

Excel VBA code.
This code with translate English in Column A to Hebrew in Column B in Worksheet 1.
This macro will stop when it hits a blank cell in Column A.

Sub translate()
    Dim i As Integer
    Dim inputstring As String, outputstring As String, text_to_convert As String
    Dim translation_result As Object
    Dim bot As WebDriver
    
    Set bot = New WebDriver
    'bot.AddArgument "--headless" 'make Chrome not visible
    bot.Start "chrome"
    
    i = 1
    While ThisWorkbook.Sheets("Sheet1").Cells(i, 1) <> ""
        'input language
        inputstring = "en"
        'output languge
        outputstring = "iw" 'es=spanish, fr=French iw=hebrew
        text_to_convert = ThisWorkbook.Sheets("Sheet1").Cells(i, 1)
        'open google translate with test to convert string
        Url = "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
        bot.Get Url
        bot.Timeouts.ImplicitWait = 5000 ' 5 seconds
        'How to get xpath of result from google translate and right click on the result, select copy and full xpath
        Set translation_result = bot.FindElementByXPath("/html/body/c-wiz/div/div[2]/c-wiz/div[2]/c-wiz/div[1]/div[2]/div[3]/c-wiz[2]/div/div[8]/div/div[1]/span[1]/span/span")
        ThisWorkbook.Sheets("Sheet1").Cells(i, 2) = translation_result.Text
        i = i + 1
    Wend
    
    bot.Quit

End Sub

This VBA code with translate English .srt subtitle to Hebrew using Google translate.
User to create Sheet1(cell A1-input file name, cell A2-output file name), Sheet2(original subtitle) and Sheet3(translated subtitle).
Input file must be in the same folder as the Excel macro file.
Under the Microsoft Excel VBA editor -> Tool -> Reference (must have Selenium Type Library, Microsoft Script Runtime)


[Attachment 74817 - Click to enlarge]

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub translate_srt()
    Dim i As Integer, j As Integer, k As Integer
    Dim input_file As String, output_file As String
    Dim data_array As Variant
    Dim my_path As String
    Dim url_1 As String, url_2 As String
    Dim FSO As New FileSystemObject

    Const ForReading = 1
    Const ForWriting = 2
    Const ForAppend = 3
    
    Dim inputstring As String, outputstring As String, read_str As String
    Dim translated_text As String
    Dim translated_results As Object
    
    Dim Driver As New Selenium.ChromeDriver
    Dim By As New Selenium.By

    
    my_path = ThisWorkbook.Path
    input_file = ThisWorkbook.Sheets("Sheet1").Cells(1, 1)
    output_file = ThisWorkbook.Sheets("Sheet1").Cells(2, 1)
    ThisWorkbook.Sheets("Sheet2").Cells.Clear
    ThisWorkbook.Sheets("Sheet3").Cells.Clear
    ThisWorkbook.Sheets("Sheet4").Cells.Clear
    Set FileToRead = FSO.OpenTextFile(my_path & "\" & input_file, ForReading, False, 0)
    '
    'input language
    inputstring = "en"
    'output languge
    outputstring = "iw" 'es=spanish, fr=French, iw=hebrew, zh-CN=simplified chinese, zh-TW=traditional chinese
    url_1 = "http://translate.google.com/#" & inputstring & "/" & outputstring & "/"
    Set Driver = CreateObject("Selenium.ChromeDriver")
    'Driver.AddArgument "--headless" 'make Chrome not visible
    Driver.Start "chrome", ""
    
    i = 1
    While (Not FileToRead.AtEndOfStream)
        read_str = FileToRead.Readline
        ThisWorkbook.Sheets("Sheet2").Cells(i, 1) = read_str
        ThisWorkbook.Sheets("Sheet3").Cells(i, 1) = read_str
        ThisWorkbook.Sheets("Sheet2").Cells(i, 1).NumberFormat = "@"
        ThisWorkbook.Sheets("Sheet3").Cells(i, 1).NumberFormat = "@"
        i = i + 1
    Wend
    j = 1
    k = 10
    l = 1
    m = 1
    done = False
    While (j < i)
        While Not done And j < i 'find number in multiple of 10
            If ThisWorkbook.Sheets("Sheet3").Cells(j, 1) = "" Then
                If ThisWorkbook.Sheets("Sheet3").Cells(j + 1, 1) = k Or j = i - 1 Then
                    done = True
                End If
            End If
            j = j + 1
        Wend
        While ThisWorkbook.Sheets("Sheet3").Cells(j, 1) <> "" 'index to the next blank
            j = j + 1
        Wend
        j = j - 1
        While m <= j
            If InStr(ThisWorkbook.Sheets("Sheet3").Cells(m, 1), "-->") > 0 Then
                If InStr(ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1), "<") = 0 Then
                    num = ThisWorkbook.Sheets("Sheet3").Cells(m - 1, 1)
                    If text_str = "" Then
                        text_str = num & "~" & ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1)
                        m = m + 1
                    Else
                        text_str = text_str & "%0A" & "^" & num & "~" & ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1)
                        m = m + 1
                    End If
                    If ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1) <> "" Then
                        text_str = text_str & "%0A" & "^" & num & "~" & ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1)
                        m = m + 1
                        If ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1) <> "" Then
                            text_str = text_str & "%0A" & "^" & num & "~" & ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1)
                            m = m + 1
                            If ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1) <> "" Then
                                text_str = text_str & "%0A" & "^" & num & "~" & ThisWorkbook.Sheets("Sheet3").Cells(m + 1, 1)
                                m = m + 1
                            End If
                        End If
                    End If
                End If
            End If
            m = m + 1
        Wend
        url_2 = url_1 & text_str
        If text_str <> "" Then
            url_2 = Replace(url_2, Chr(34), "")
            Driver.Get url_2
            Sleep 2000
            num = 0
            Start = 1
            If Driver.IsElementPresent(By.XPath("/html/body/c-wiz/div/div[2]/c-wiz/div[2]/c-wiz/div[1]/div[2]/div[3]/c-wiz[2]/div/div[8]/div/div[1]/span")) Then
                Set translated_results = Driver.FindElementByXPath("/html/body/c-wiz/div/div[2]/c-wiz/div[2]/c-wiz/div[1]/div[2]/div[3]/c-wiz[2]/div/div[8]/div/div[1]/span")
                translated_text = translated_results.Text
                data_array = Split(translated_text, "^")
                For n = 0 To UBound(data_array)
                    data_array_span = Split(data_array(n), "~")
                    If (UBound(data_array_span) + 1) > 1 Then
                        data_array_span(1) = Replace(data_array_span(1), vbLf, "")
                        If num <> Int(Replace(data_array_span(0), " ", "")) Then
                            num = Int(Replace(data_array_span(0), " ", ""))
                            For ptr = 1 To j
                                If num = ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) Then
                                    Exit For
                                End If
                            Next ptr
                            ptr = ptr + 2
                            ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) = data_array_span(1)
                        Else
                            ptr = ptr + 1
                            ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) = data_array_span(1)
                        End If
                    Else
                        data_array_span(0) = Replace(data_array_span(0), vbLf, "")
                        If outputstring = "iw" Then 'read from right to left
                            ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) = data_array_span(0) & ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1)
                        Else 'read from left to right
                            ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) = ThisWorkbook.Sheets("Sheet3").Cells(ptr, 1) & data_array_span(0)
                        End If
                    End If
                Next n
            End If
            m = j + 1
            k = k + 10
            text_str = ""
            done = False
        Else
            j = j + 1
        End If
    Wend

    Driver.Quit
    FileToRead.Close
    
    'Write translated subtitle to  .srt file.
    Set FileToWrite = FSO.OpenTextFile(my_path & "\" & output_file, ForWriting, True, TristateMixed)
    For i = 1 To j - 1
        FileToWrite.Write ThisWorkbook.Sheets("Sheet3").Cells(i, 1) & Chr(13)
    Next i
    FileToWrite.Close

End Sub

Sample output from Star Wars - Phantom Menace
0
00:00:00,000 --> 00:02:01,000
<font color=yellow><u>facebook.com/sazu489</u></font>

1
00:02:01,000 --> 00:02:02,059
- קפטן.
- כן אדוני?

2
00:02:03,136 --> 00:02:05,263
תגיד להם שאנחנו רוצים
לעלות בבת אחת.

3
00:02:05,372 --> 00:02:08,000
- [צפצוף מכונות]
- עם כל הכבוד,

4
00:02:08,108 --> 00:02:11,545
השגרירים לעליון
הקנצלר מבקש לעלות מייד.

5
00:02:11,646 --> 00:02:13,546
כן כמובן.

[ProWo]

Hello,
I am trying to translate an English subtitle into Hebrew.
Until some time ago, there is a site I could upload the file
and get it translated fine. Since it was updated, it makes a mess
- missing lines, breaking lines.
I also tried to open the subtitle into Google Chrome, translate, select all, copy and paste into notepad,
Renamed to ...srt file, bad results.
Any other idea, please ?
Answers will be appreciated.
Thanks
Motim

Try https://subtitlestranslator.com/en/