Macro to convert delimited text files to excel file

[abberyfarm]

Hi there,

Would anyone have a macro to go to a folder and convert 100's of delimited text files to excel files and save them to another folder?

Here is an example of a few rows of data in the text files.

"2011-08-17 13:22:29"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"118"|"4"|"472"|"0"|"465"
"2011-08-17 13:22:30"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"116"|"4"|"464"|"0"|"465"
"2011-08-17 13:22:31"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"140"|"4"|"560"|"0"|"465"
"2011-08-17 13:22:32"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"142"|"4"|"568"|"0"|"465"
"2011-08-17 13:22:33"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"142"|"4"|"568"|"0"|"465"
"2011-08-17 13:22:34"|"357464030122441"|"0"|\N|"0"|"53.40405"|"-6.25686"|\N|"15"|"P"|"142"|"4"|"568"|"0"|"465"

Help very much appreciated!

 

[Andrew Poulsom]

Why the need to convert them when they can be opened directly in Excel with | as the delimiter?

 

[abberyfarm]

Hi,

Well I have another macro that goes to the folder with the excel files in them and opens each file individually and process the data and saves it to another folder.

It will not work if the files are text files, because it puts all the data in column A.

Heres the code that I use to loop through all the excel files in the folder. I don't know how to make it import the data with| as the delimiter.

Could you incorporate it into this code? It would be a great help

Sub Startprocess()
    '//Change the path to the main folder, accordingly
    Call RecursiveFolders("C:\Main folder")
End Sub

Sub RecursiveFolders(ByVal MyPath As String)

    Dim FileSys As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim wkbOpen As Workbook
    
    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FileSys.GetFolder(MyPath)

    Application.ScreenUpdating = False
    
    For Each objSubFolder In objFolder.SubFolders
    
        For Each objFile In objSubFolder.Files
            Set wkbOpen = Workbooks.Open(FileName:=objFile)
            
            'Check first speed value, should be = 0, if not save file to 'bad data' folder and close
             Range("c2").Select
             If ActiveCell.Value > 0 Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs FileName:="C:\Bad data 5 sec\" & ActiveWorkbook.Name
    
    Else
     'Call macro to process and save data
            Call torque_kin
    End If
           
        wkbOpen.Close savechanges:=False
        Next
        Call RecursiveFolders(objSubFolder.Path)
    Next

    Application.ScreenUpdating = True
    
End Sub

 

[tigeravatar]

abberyfarm,

The following macro will take all .txt files in a specified path, put the contents in an Excel sheet and perform TextToColumns with delimiter | and then save the sheet in a specified folder. Just open a new excel workbook, paste the code in standard module, change the txtFldrPath and xlsFldrPath as necessary and let it run:

Sub tgr()
    
    Const txtFldrPath As String = "C:\Text Folder"      'Change to folder path containing text files
    Const xlsFldrPath As String = "C:\Excel Folder"     'Change to folder path excel files will be saved to
    
    Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "*.txt")
    Dim strLine() As String
    Dim LineIndex As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    While CurrentFile <> vbNullString
        LineIndex = 0
        Close #1
        Open txtFldrPath & "\" & CurrentFile For Input As #1
        While Not EOF(1)
            LineIndex = LineIndex + 1
            ReDim Preserve strLine(1 To LineIndex)
            Line Input #1, strLine(LineIndex)
        Wend
        Close #1
        
        With ActiveSheet.Range("A1").Resize(LineIndex, 1)
            .Value = WorksheetFunction.Transpose(strLine)
            .TextToColumns Other:=True, OtherChar:="|"
        End With
        
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
        ActiveWorkbook.Close False
        ActiveSheet.UsedRange.ClearContents
        
        CurrentFile = Dir
    Wend
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar

 

[abberyfarm]

Hi tigeravatar,

That macro works perfect! I tried lots of macros up till now and could get them to work

Thank you for your help

J

 

[abberyfarm]

One other thing,

Can I change it to not save the text files into the excel folder aswell?

Thank you

 

[tigeravatar]

You're welcome and thank you for the feedback

 

[abberyfarm]

Sorry ignore that request, I copied the text files into excel folder myself by accident!

 

[tigeravatar]

I'm not sure I understand what you mean by:

change it to not save the text files into the excel folder aswell

As far as I know, and on my test, the text files were not resaved at any point

 

[maristarry]

Hello, I'm new to Excel macros. Would it be possible to convert this code to do semicolon delimited text files and then delete the text files once they are converted to xls?

abberyfarm,

The following macro will take all .txt files in a specified path, put the contents in an Excel sheet and perform TextToColumns with delimiter | and then save the sheet in a specified folder. Just open a new excel workbook, paste the code in standard module, change the txtFldrPath and xlsFldrPath as necessary and let it run:

Sub tgr()
    
    Const txtFldrPath As String = "C:\Text Folder"      'Change to folder path containing text files
    Const xlsFldrPath As String = "C:\Excel Folder"     'Change to folder path excel files will be saved to
    
    Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "*.txt")
    Dim strLine() As String
    Dim LineIndex As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    While CurrentFile <> vbNullString
        LineIndex = 0
        Close #1
        Open txtFldrPath & "\" & CurrentFile For Input As #1
        While Not EOF(1)
            LineIndex = LineIndex + 1
            ReDim Preserve strLine(1 To LineIndex)
            Line Input #1, strLine(LineIndex)
        Wend
        Close #1
        
        With ActiveSheet.Range("A1").Resize(LineIndex, 1)
            .Value = WorksheetFunction.Transpose(strLine)
            .TextToColumns Other:=True, OtherChar:="|"
        End With
        
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
        ActiveWorkbook.Close False
        ActiveSheet.UsedRange.ClearContents
        
        CurrentFile = Dir
    Wend
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar