Importing Data from an .SRT-FIle into Excel-CodePudding

I am struggling with something I think it is really easy to fix... but I still don't get it done.

Please keep in my mind, I am not a pro at programming.

So I build myself an Excel template which converts .SRT files into a script format.

The structure of an .Srt file is like this:

NUMBER OF SUBTITLE

TIMECODE IN --> TIMECODE OUT

LINE OF TEXT

(.SRT-File-Structure)

1

00:00:01,369 --> 00:00:04,500

Hello there

2

00:00:05,102 --> 00:00:10,200

I am Manuel

(... and so on)

My problem is that I don't get the data successfully imported. I tried in a very simple way which I used this VBA code for:

Sub Datei_auswaehlen()
 
Dim Dateiname As Variant
Dim wbQuelle As Workbook
Dim letzteZeile As Long
 
'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 

Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")
 

If Dateiname <> False Then
 
    letzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
 
   
    Set wbQuelle = Workbooks.Open(Filename:=Dateiname)
     
  
    wbQuelle.Worksheets(1).Range("A:A").Copy
    ThisWorkbook.Worksheets(1).Range("A:A").PasteSpecial
     
 
    
    wbQuelle.Close SaveChanges:=False
     
End If
 

Application.ScreenUpdating = True
Application.DisplayAlerts = True
 

End Sub

What I want it that it copies everything into Excel in column A, so I can it further process.

But for some reason I don't know with some .srt files which look exactly the same, they are cut in half like this:

1

00:00:41

Text in Line 1


2

00:00:45

Text in Line 2

Can someone help me out with some better way to do this?

All the best,

Manu

CodePudding user response：

Please, test the next updated code. It will open the file using OpenText and will paste its first pate, first column content in the active sheet of the workbook keeping the code (so, it must have its first column empty, otherwise, the code will overwrite its content):

Sub Datei_auswaehlen()
 Dim Dateiname As String, wbQuelle As Workbook, letzteZeile As Long, shC As Worksheet
 
 'ScreenUpdating und PopUps deaktivieren
 Application.ScreenUpdating = False
 
 Set shC = ActiveSheet  'use here the sheet to copy in

 Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")

 If Dateiname <> "" Then

    Workbooks.OpenText fileName:=Dateiname, origin:=65001, _
            startRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True _
           , space:=False, Other:=False, FieldInfo:=Array(1, 2)
           
     Set wbQuelle = ActiveWorkbook
     letzteZeile = wbQuelle.Worksheets(1).cells(rows.count, 1).End(xlUp).row
     
     With wbQuelle.Worksheets(1).Range("A1:A" & letzteZeile)
          shC.Range("A1").Resize(.rows.count, .Columns.count).Value = .Value
    End With
    shC.Range("A:A").EntireColumn.AutoFit
    
    wbQuelle.Close SaveChanges:=False
     
 End If

Application.ScreenUpdating = True
End Sub

Please, send some feedback after testing it. If something not clear enough, do not hesitate to ask for clarifications.