Save Each Row As A Text File - Including Text Formatting

[shana]

Hi to all,


I am hoping a kind individual may be able to help me solve this problem.

I have a macro that imports text files into excel Rows perfectly.

I am now trying to re-save these Rows as individual text files.

So that each row is saved as a text file with the original formatting.

Here is the original code used to import text files.

Option Explicit
Sub ImportCompleteTextFileAndName()


'Imports Each Text Files into a Single cell - With Original Formatting
'Imports the File Name into Column A

    
    Dim sPath As String
    Dim iRow As Long
    Dim strString  As String
    
    Dim fso As FileSystemObject
    Dim xFile As File
    Dim xFolder As Folder
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set xFolder = fso.GetFolder("C:\Users\Desktop\Import\")
    
    iRow = 2         ' Row to start inserting data
    
    For Each xFile In xFolder.Files
        
        If InStr(1, xFile.Name, ".txt") <> 0 Then
        
            Dim lFile As Long
            Dim szLine As String
            
            lFile = FreeFile()
            
            Open xFile.Path For Input As lFile
            
            strString = ""
            While Not EOF(lFile)
            
                Line Input #lFile, szLine
            
                ' Concatenete lines from text file
                strString = strString & szLine & vbCrLf
                
            Wend
            
          
          
        '==========================================
        ' Column 1 = A , 2 = B, 3 = C, 4 =D, 5 = E
        
        
        
            
        ' Import Text file
        Cells(iRow, 5).Value = strString      ' Imports text file into E
            
            
        '========= Import the File Name

         Cells(iRow, 4).Value = xFile.Name        ' Imports the filename into Column D

         iRow = iRow + 1
            
        
            ' Close the file
            Close lFile
            
            Application.ScreenUpdating = True
                        
        End If
        
    Next ' End of LOOP
    
    MsgBox "Completed!"
    
    
    'Adapted From Original
    'http://www.mrexcel.com/forum/excel-questions/909742-visual-basic-applications-excel-import-text-file-names-into-column.html#post4374692
    'http://www.mrexcel.com/forum/excel-questions/462499-import-whole-text-file-into-single-cell.html
   
End Sub

The whole purpose of importing text files is so that I may be able to add some additional information in other columns then re-output the new text file with original formatting - including the line breaks and spaces.


I have referenced many threads including one below to try and solve this task:

Write each Excel row to new .txt file with ColumnA as file name - Stack Overflow

Sub SaveEachRowAsTextFile()

'Save each Row as a text file  - With Original Formatting including Line breaks

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet

Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range

filePath = "C:\Users\Desktop\a\" '<--- Modify this for your needs.

For Each cell In Range("A2", Range("A2048576").End(xlUp))
   Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))

   fileName = filePath & cell.Offset(0, -1).Value
   


   '
   ' Insert code to write the text file here
   
   Set wbNew = ActiveWorkbook
        Set wsTemp = wbNew.Worksheets(1)
        wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
        wbNew.Close
        ThisWorkbook.Activate
        r = r + 1
    Loop

   '
   ' you will be able to use the variable "fileName" when exporting the file
Next
End Sub

I apologize for my newbie skills - but I have tried adapting code snippets as well as look at other alternatives and adapt various codes - however I am just not doing things right, due to my lack of knowledge.

If any one would be kind enough to point me in the right direction, I would be extremely grateful. As per the code I don't mind if the file name starts in column A - I am just trying to figure out how to loop over the rows to output each row to a text file.



To Summarise


I am trying to save each row as a text file with the original formatting.


I would be really grateful for any help.

Thank you so much in advance for your time and help

Shana

 

[LockeGarmin]

Hi Shana,

I rewrote some of the code in the method "ImportCompleteTextFileAndName" because it used a style of writing to files that I've never really been able to figure out and it would demonstrate how to read a file using a TextStream object since you are already using the Scripting library. With a TextStream object and you can use that to either read, write or append files. The method "SaveEachRowAsTextFile" is what you were really asking about. The tabs and spaces were all still there after running it. In that one i just used the Folder object to create a File and TextStream objects and used the TextStream to write contents from the spreadsheet. Hope this helps!

Option Explicit

Sub ImportCompleteTextFileAndName()

'Imports Each Text Files into a Single cell - With Original Formatting
'Imports the File Name into Column A
    
    Dim sPath As String
    Dim iRow As Long
    Dim sFileContents As String
    
    Dim FSO As Scripting.FileSystemObject
    Dim xFile As Scripting.File
    Dim xFolder As Scripting.Folder
    Dim xStream As Scripting.TextStream
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = FSO.GetFolder("C:\Users\Desktop")
    
    iRow = 2
    
    Application.ScreenUpdating = False
    
    For Each xFile In xFolder.Files
        If xFile.Name Like "*.txt" Then
            
            'Use a TextStream to get file contents
            Set xStream = xFile.OpenAsTextStream(ForReading)
            sFileContents = xStream.ReadAll
            xStream.Close
                        
            'Write file contents to excel spreadsheet
            Cells(iRow, "D").Value2 = xFile.Name
            Cells(iRow, "E").Value2 = sFileContents
            
            iRow = iRow + 1
     
        End If
        
    Next xFile
    
    Application.ScreenUpdating = True
    
    MsgBox "Completed!"
       
End Sub


Sub SaveEachRowAsTextFile()

Dim FSO As Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim Stream As TextStream

Dim ContentsRange As Range
Dim Row As Range

Dim FileName As String
Dim FileContents As String

Const FolderPath As String = "C:\Users\Desktop\a"

    Set ContentsRange = Range("A2", ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell))
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FolderPath)
  
    For Each Row In ContentsRange.Rows
        FileName = Row.Columns("D").Value2
        FileContents = Row.Columns("E").Value2
        
        'Create new file and write contents to it
        Set Stream = Folder.CreateTextFile(FileName)
        Call Stream.Write(FileContents)
        Stream.Close
    
    Next Row

    MsgBox "Completed!"
  
End Sub

 

[shana]

Hi LockeGarmin,

thank you so much for helping me.

I ran the SaveEachRowAsTextFile

This saves the file to a folder with Column D as filename and contents in Column E, so that is great. I noticed the file did not save with an extension .txt . I don't mind I can change it with bulk rename utility if needs be


There is also content in column F,G,H

Am I able to add those column data on - when trying to save each row? As well as include the line breaks in the original content.
It is saving the content all as one body of text - without any original line breaks.

I apologise am I running it wrong?


I am really grateful for your help

thank you so much

shana

 

[LockeGarmin]

Hi Shana,

I made the assumption that in excel your files were going to be called "SomeFile.txt", but I'm guessing they are just called "SomeFile". You can either add the .txt at the end of each cell or you can change the macro to the following:

[COLOR=#333333]Set Stream = Folder.CreateTextFile(FileName & ".txt")[/COLOR]

If it were me I'd just change the spreadsheet but you can't really go wrong either way.

 

[shana]

Hi LG,

thank you, it now saves with the text extension.

I am afraid - I still messed up the code

Sub SaveEachRowAsTextFile()

Dim FSO As Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim Stream As TextStream

Dim ContentsRange As Range
Dim Row As Range

Dim FileName As String
Dim FileContents As String

Const FolderPath As String = "C:\Users\Desktop\b"

    Set ContentsRange = Range("A2", ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell))
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FolderPath)
  
    For Each Row In ContentsRange.Rows
        FileName = Row.Columns("D").Value2

       ' Save each Row with the original Line Breaks

        FileContents = Row.Columns("E" + "F" + "G" & szLine & vbCrLf).Value2
        
       
        
        
        'Create new file and write contents to it
     
     
        Set Stream = Folder.CreateTextFile(FileName & ".txt")
        
        
        Call Stream.Write(FileContents)
        Stream.Close
    
    Next Row

    MsgBox "Completed!"
  
End Sub

No doubt, I can't just add the columns on as I have - that would be just great, problem solved.

How can I output the whole row as a text file including the line breaks - if you have any ideas I would be very grateful.

Thank you

Shana

 

[LockeGarmin]

Hi Shana,

You have a few options.

FileContents = Row.Columns("E").Value2 & [COLOR=#333333]vbCrLf
[/COLOR]FileContents = FileContents & Row.Columns("F").Value2 & [COLOR=#333333]vbCrLf
[/COLOR]FileContents = FileContents & Row.Columns("G").Value2

or

FileContents = Row.Columns("E").Value2 & [COLOR=#333333]vbCrLf & _
[/COLOR]                        Row.Columns("F").Value2 & [COLOR=#333333]vbCrLf & _
[/COLOR]                        Row.Columns("G").Value2

or

For Each Row In ContentsRange.Rows
        FileName = Row.Columns("D").Value2
        
        'Create new file and write contents to it
        Set Stream = Folder.CreateTextFile(FileName & ".txt")
        
        'Save each Row with the original Line Breaks 
        Call Stream.WriteLine(Row.Columns("E").Value2)
        Call Stream.WriteLine(Row.Columns("F").Value2)
        Call Stream.WriteLine(Row.Columns("G").Value2)


        Stream.Close
    
Next Row

I'm not sure what szLine is that you have in your code so I'll let you add that where appropriate. Hope that helps!

 

[shana]

Hi LG,

thank you for the additional code.

I have been able to add on the contents of Columns E, F and G with the code you gave below.

FileContents = Row.Columns("E").Value2 & [COLOR=#333333]vbCrLf & _
[/COLOR]                        Row.Columns("F").Value2 & [COLOR=#333333]vbCrLf & _
[/COLOR]                        Row.Columns("G").Value2

Sadly it still does not output the original Line breaks in the cell.

Each Cell has formatted Text as shown below - when the Text file is saved - it outputs it as one long concatenated string with no spaces , which I have to edit manually to get it back to the way it was in the cells.

So close -


If you or any one else has any ideas do let me know

thank you

Shana