Macro to search a text file of which contains "_res_av_" in its file name, in folders and sub folders, open it and save as excel in the same location

[Swaroop Kavi]

Hello,

I am looking for a vba code to find a text file which contains the file name "_res_av_" in folders and subfolders, open it in excel, select column "A", Data > Text to columns > Delimited > Tab and Space, and save as excel file with the name same as text file in the same location.

 

[JEC]

Something like this

Sub JEC()
   Application.ScreenUpdating = False
   jv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\xxx\Documents\xxx\*_res_av_*"" /b/s").stdout.readall, vbCrLf)
  
   For Each it In jv
      If Len(it) Then
         With Workbooks.Open(it).Sheets(1)
            .Range("A1:A1000").TextToColumns .Cells(1, 1), 1, , , 1, , , 1
            .SaveAs Replace(Replace(it, ".xlsm", ".txt"), "xlsx", "txt"), 21
            .Parent.Close
         End With
      End If
   Next
End Sub

 

[Swaroop Kavi]

Thank you JEC.

It's working perfectly fine until delimiting text to column option. But while it should save the excel file, its replacing the existing text file with new text file with the same name. Is it possible to modify the code to save the excel file?

 

[JEC]

Probably like this but you may have to adapt the TextToColumns a bit. Record a macro in a testfile and put that TextToColumns line in this code.

Sub JEC()
   Application.ScreenUpdating = False
   jv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\xxx\Downloads\*_res_av_*"" /b/s").stdout.readall, vbCrLf)

   For Each it In jv
      If Len(it) Then
         With Workbooks.Open(it).Sheets(1)
            .Range("A1:A1000").TextToColumns .Cells(1, 1), 1, , , 1, , , 1
            .SaveAs Replace(it, ".txt", ".xlsx")
            .Parent.Close
         End With
      End If
   Next
End Sub

 

[Swaroop Kavi]

That works. Thank you very much JEC.

 

[JEC]

Nice! You're welcome