Macro to read all .txt files in a folder, open them as fixed format and save them as .xls files

[ABer1]

Hi,

I have a number of .txt files in a folder with different names. I want to import the data with a fixed width and create a break line at a desired position. Then I insert a row above the data and variable names. After this, I save the document as a .xls with the same name.
I have done this and recorded it as a macro, but I am having problems with the loop over the files. The code works but seems to use the same file all the time and over write it instead of going through all files in a loop.
I am not sure if it is a mistake in the save name file or in the loop itself. I would be very grateful if you could help me with this. Thank you in advance.

Sub TXTFILESR()

 Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String

 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = -1 Then

 folderName = .SelectedItems(1)
 End If
 End With

 myfile = Dir(folderName & "\*.txt")
 
 Do While myfile <> ""
 Workbooks.OpenText FileName:=folderName & "\" & myfile, Origin:=932, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(6, 1), Array(8, 1), Array(10, 1), Array(16, 1), Array(19, 1) _
    , Array(24, 1), Array(31, 1), Array(36, 1), Array(43, 1), Array(48, 1), Array(55, 1), Array( _
    60, 1), Array(67, 1), Array(72, 1)), TrailingMinusNumbers:=True
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "YEAR"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "MONTH"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "DAY"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "HOUR"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "MIN"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "FLAG"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "WAVE No."
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Hs mean"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Tp mean"

    ActiveWorkbook.SaveAs FileName:= _
        folderName & "\" & Replace(myfile, ".txt", ".xls") _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
Loop


End Sub

 

[DanteAmor]

Hi and welcome to MrExcel!

How about:

Sub TXTFILESR()
  Dim MyFolder As String, myfile As String, folderName As String
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    folderName = .SelectedItems(1)
  End With
  '
  myfile = Dir(folderName & "\*.txt")
  Do While myfile <> ""
    Workbooks.OpenText Filename:=folderName & "\" & myfile, Origin:=932, StartRow:=1, _
      DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(6, 1), Array(8, 1), _
      Array(10, 1), Array(16, 1), Array(19, 1), Array(24, 1), Array(31, 1), Array(36, 1), _
      Array(43, 1), Array(48, 1), Array(55, 1), Array(60, 1), Array(67, 1), Array(72, 1)), TrailingMinusNumbers:=True
    Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Resize(1, 9) = Array("YEAR", "MONTH", "DAY", "HOUR", "MIN", "FLAG", "WAVE No.", "Hs mean", "Tp mean")
    ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xls"), _
      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
    myfile = Dir()
  Loop
End Sub

 

[ABer1]

Thank you DanteAmor! It works

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.