SRT Dosyasını, Sıra Numarasını ve Zaman Damgasını Temizleyip TXT Dosyasına Dönüştürmek

SRT dosyasındaki sıra numarasını ve zaman damgasını temizlemek için butona basınız.

Dosyanın SRT dosyası olduğundan emin olunuz.

Dilerseniz satır boşluklarını da silebilirsiniz.

Yeni dosya, "dosya adı"_edit.txt adıyla bu dosyanın bulunduğu klasörde oluşturulacaktır.

Dim DosyaSec As FileDialog Dim i As Long Dim j As Long Dim SiraNo As Long Dim SRTDosyasi As String Dim Veri As String Dim Arr() As String Dim DosyaAdi As String Dim Soru1 As String Dim Soru2 As String Dim Yanit1 As Boolean Dim Yanit2 As Boolean Dim FSO As Scripting.FileSystemObject Dim RegEx As Object Dim RegMatches As Object Dim RegMatch As Object Sub SRT_to_TXT() Set FSO = New Scripting.FileSystemObject Set DosyaSec = Application.FileDialog(msoFileDialogFilePicker) With DosyaSec .AllowMultiSelect = False If .Show <> -1 Then Exit Sub End If SRTDosyasi = DosyaSec.SelectedItems(1) DosyaAdi = FSO.GetFileName(DosyaSec.SelectedItems(1)) DosyaAdi = Mid(DosyaAdi, 1, Len(DosyaAdi) - (Len(FSO.GetExtensionName(DosyaAdi)) + 1)) End With If LCase(Right(SRTDosyasi, 4)) <> ".srt" Then Soru2 = MsgBox("Sectiginiz dosya SRT dosyasi degil, devam etmek istiyor musunuz?", vbYesNo) If Soru2 = vbYes Then DoEvents Else GoTo Cikis: End If End If Soru1 = MsgBox("Bos satirlar silinsin mi?", vbYesNo, "Soru") If Soru1 = vbYes Then Yanit1 = True Else Yanit1 = False End If Set ADO = CreateObject("ADODB.Stream") ADO.Charset = "utf-8" ADO.Open ADO.LoadFromFile SRTDosyasi Veri = ADO.ReadText ADO.Close Set RegEx = CreateObject("VBScript.RegExp") With RegEx .Global = True .Pattern = "(([01]\d|2[0-3]):[0-5]\d:[0-5]\d,[0-9]{3})" End With If UBound(Split(Veri, Chr(10))) > 0 Then For i = 1 To UBound(Split(Veri, Chr(10))) If Yanit1 = True Then If Len(Split(Veri, Chr(10))(i - 1)) > 0 Then Set RegMatches = RegEx.Execute(Split(Veri, Chr(10))(i - 1)) If RegEx.Test(Split(Veri, Chr(10))(i - 1)) = False Then j = j + 1 ReDim Preserve Arr(1 To j) Arr(j) = Split(Veri, Chr(10))(i - 1) End If End If Else Set RegMatches = RegEx.Execute(Split(Veri, Chr(10))(i - 1)) If RegEx.Test(Split(Veri, Chr(10))(i - 1)) = False Then j = j + 1 ReDim Preserve Arr(1 To j) Arr(j) = Split(Veri, Chr(10))(i - 1) End If End If Next i For i = LBound(Arr) To UBound(Arr) If IsNumeric(Arr(i)) = True Then SiraNo = SiraNo + 1 Arr(i) = "" End If Next i End If If Dir(ThisDocument.Path & Application.PathSeparator & DosyaAdi & "_edit.srt") <> "" Then Kill ThisDocument.Path & Application.PathSeparator & DosyaAdi & "_edit.srt" End If Set ADO = CreateObject("ADODB.Stream") ADO.Charset = "utf-8" ADO.Open If Yanit1 = True Then For i = LBound(Arr) To UBound(Arr) If Len(Arr(i)) > 0 Then ADO.WriteText Arr(i) ADO.WriteText vbNewLine End If Next i Else For i = LBound(Arr) To UBound(Arr) ADO.WriteText Arr(i) ADO.WriteText vbNewLine Next i End If ADO.SaveToFile ThisDocument.Path & Application.PathSeparator & DosyaAdi & "_edit.txt", 2 ADO.Close MsgBox SiraNo & " satirlik altyazi dosyasi ayiklandi.", vbInformation Cikis: Erase Arr Veri = "" i = 0 j = 0 SiraNo = 0 End Sub 'Kaynak: Bard, ChatGPT v3.5 _ Derleme: Muharrem DOGANCI, 4.11.2023 Cumartesi 'RegEx.Test(Veri) : Test sonucu "True" ya da "False" gelir 'RegMatches(1).Value : Test sonucu "True" gelirse, sirali sorgulama islem ornegi