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

New Member
Joined
Aug 25, 2021
Messages
4
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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.
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

JEC

Active Member
Joined
Aug 21, 2021
Messages
456
Office Version
  1. 365
Platform
  1. Windows
Something like this

VBA Code:
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

New Member
Joined
Aug 25, 2021
Messages
4
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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

Active Member
Joined
Aug 21, 2021
Messages
456
Office Version
  1. 365
Platform
  1. Windows
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.

VBA 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
 

JEC

Active Member
Joined
Aug 21, 2021
Messages
456
Office Version
  1. 365
Platform
  1. Windows
Nice! You're welcome
 

Forum statistics

Threads
1,143,619
Messages
5,719,764
Members
422,244
Latest member
AYSHANA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top