Macro to save as txt

Olga Goldberg

New Member
Joined
Jul 9, 2008
Messages
19
Hi, everyone!

I'm new here, and I'm totaly ignorant.

I work with a read-only template, and desperately need a macro that would save it as a workbook, and every worksheet of it as a separate txt file, then close the whole thing. I will be re-using that workbook it just saved again, and I want to have the same macro there as well (that it should save my workbook as workbook and every worksheet as a separate txt file).

Can anyone PLEASE help?

Thank you very much in advance

Olga Goldberg
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Hope this helps. I've saved as .txt files and used a txt file format, but many people like to have .csv files when they say "text" so let me know if these files come out correctly for you. Also, you haven't specified any naming convention or location for your files - this routine saves them in the same folder and with a date/time based code to create a unique file name every time.

Note: It "abandons" the template every time you run it - everything is copied to the new workbook first, then the sheets are saved one by one - the template would remain as it was when last saved. This saves the macro with the copy - should be alright, but if that's a problem, you can put the code in an entirely different workbook altogether (it doesn't need to be in the template or in the copies, really).

AB

Code:
Sub CopyWorkbookAndSheets()
'----------------------------------------------------------------------------
'Purpose: To save a copy of the workbook and copy each sheet as a text file.
'Note: Code is written to be saved in a Template file which is this workbook.
'----------------------------------------------------------------------------

Dim wb As Workbook
Dim ws As Worksheet
Dim strSaveWorkbookAs_Name As String
Dim strSaveSheetAs_Name As String
Dim intCount As Integer

'Set Reference
Set wb = ThisWorkbook

'File Name for Copy (XL 2003 - uses .xls file extension)
strSaveWorkbookAs_Name = wb.Name & "_" & Format(Now, "yyyy-mm-dd_hhnnss") & ".xls"

'Save Workbook (Template is not saved...)
wb.SaveAs Filename:=strSaveWorkbookAs_Name, FileFormat:=xlWorkbookNormal

'_______________________________________________________________
'Save Text files
'---------------------------------------------------------------
For Each ws In wb.Worksheets
    'Unique FileName for new file
    strSaveSheetAs_Name = strSaveWorkbookAs_Name & "_" & ws.Name & ".txt"
    ws.Copy
    
    'Copied sheet will be active - save as text and close
    With ActiveWorkbook
        .SaveAs Filename:=strSaveSheetAs_Name, FileFormat:=xlText 'Or xlCSV
        .Close SaveChanges:=True
    End With

Next ws
'---------------------------------------------------------------
   
End Sub
 
Upvote 0
Hi AB,

Thank you SO very much!

You're right, I'm sorry, I didn't specify filenames and locations. Same location is great. Filenames I don't need unique, I need txts to be named after the worksheets they came from, i.e. worksheet ABCD gets saved as ABCD.txt. The problem is that there's already an ABCD.txt file at that location, and I want the new one to replace the old one, whenever I run this macro. It's crucial that the name stays the same.

I tried your script, but it only saves as workbook, and first three worksheets as text, and then says there's an error. I'd greatly appreciate your help with this, but if you don't have time - I'll play with it myself. You've already helped me enormously, and I'm very grateful.

THANK YOU SO MUCH!!!

Olga Goldberg
 
Upvote 0
If you get chance, let me know what the error message is, and what line it stops on...

AB

You'd probably want to test for file existence and kill the file if it already exists...it be safer to use full paths to identify the folder where the files are, but it will work in the current Excel folder if you only use file names.

Code:
Function MyFileExists(strPath As String) As Boolean
    If Dir(strPath) > "" Then
        MyFileExists = True
    Else
        MyFileExists = False
    End If
End Function
'---------------------------
Sub TestIt()
    On Error GoTo Handler:
    If MyFileExists("TestIt.xls") Then Kill "TestIt.xls"
Handler:
MsgBox "Error " & Err.Number & " occurred in Sub TestIt: " & vbCrLf & Err.Description
End Sub
 
Upvote 0
Thank you so very much!

The error message is:

Run-time error '1004':
Method 'Copy' of object '_Worksheet' failed

Debug highlights the line that says "ws.Copy", under Save Text files, Unique FileName for new file, just above 'Copied sheet will be active - save as text and close

I think I know why - I have some hidden sheets. I moved them all towards the end, now it saves everything I need before giving me this error. So sorry I'm clueless as to what's important to mention and what's not...

And I can't figure how to name files after worksheet names...

Thank you so very much!!!

Olga Goldberg
 
Upvote 0
Here's some new ideas...please read the note about setting a reference to the microsoft scripting runtime. This code should be placed in a standard module (in the visual basic window: Insert | Module)

I can't bring myself to delete files here so I've created a folder for backups...If you really prefer, I can adjust this to just delete the files.

I hope this helps - maybe you're all set already but anyway let me know if everything is okay now.

Code:
Option Explicit
Dim fso As FileSystemObject
Dim homeFolder As Folder
Dim backupFolder As Folder
'-------------------------
Sub CopyWorkbookAndSheets()
'----------------------------------------------------------------------------
'Purpose: To save a copy of the workbook and copy each sheet as a text file.
'Note: Code is written to be saved in a Template file which is this workbook.

'IMPORTANT: To use this code you must set a reference for Scripting Runtime
    '1.  In the VBE window (Alt + F11), Choose Tools | References
    '2.   Check the box for Microsoft Scripting Runtime
'----------------------------------------------------------------------------
Dim wb As Workbook
Dim ws As Worksheet
Dim strName As String, strFullName As String
Dim intCount As Integer

'_______________________________________________________________
'References
'---------------------------------------------------------------
Set fso = New FileSystemObject
Set wb = ThisWorkbook
Set homeFolder = fso.GetFolder(wb.Path)

'_______________________________________________________________
'Folder for backups
'---------------------------------------------------------------
If Not fso.FolderExists(homeFolder.Path & "\Backups") Then
    Set backupFolder = fso.CreateFolder(homeFolder.Path & "\Backups")
Else
    Set backupFolder = fso.GetFolder(homeFolder.Path & "\Backups")
End If

'_______________________________________________________________
'Save Workbook
'---------------------------------------------------------------
'File Name for Workbook Copy (XL 2003 - uses .xls file extension)
strName = wb.Name & "_" & Format(Now, "yyyy-mm-dd_hhnnss") & ".xls"
strFullName = homeFolder.Path & "\" & strName

'Save Workbook (Template is not saved...)
wb.SaveAs Filename:=strFullName, FileFormat:=xlWorkbookNormal
'---------------------------------------------------------------

'Save worksheets as text
Call SaveWorksheetsAsText(wb)

'Cleanup
If Not fso Is Nothing Then Set fso = Nothing
If Not homeFolder Is Nothing Then Set homeFolder = Nothing
If Not backupFolder Is Nothing Then Set backupFolder = Nothing

End Sub
'-------------------------------
Private Sub SaveWorksheetsAsText(ByRef wb As Workbook)
Dim ws As Worksheet
Dim strName As String
Dim strFullName As String

'_______________________________________________________________
'Save Text files
'---------------------------------------------------------------
For Each ws In wb.Worksheets
    
    'Skip hidden sheets
    If ws.Visible = xlSheetVisible Then
    
        'Unique FileName for new file
        strName = ws.Name & ".txt"
        strFullName = homeFolder.Path & "\" & strName
        
        'If file of same name exists, make a backup copy and delete
        If fso.FileExists(strFullName) Then
            Dim strSource As String
            Dim strDest As String
            strSource = strFullName
            strDest = backupFolder.Path & "\" & ws.Name & "_" & Format(Now, "yyyy-mm-dd_hhnnss") & ".txt"
            fso.CopyFile strSource, strDest
            fso.DeleteFile strSource
        End If
            
        'Copy sheet (creates new workbook of one sheet)
        ws.Copy
        
        'Copied sheet will be active - save as text and close
        With ActiveWorkbook
            .SaveAs Filename:=strFullName, FileFormat:=xlText 'Or xlCSV
            .Close SaveChanges:=True
        End With
    
    End If
    
Next ws

End Sub
 
Upvote 0
Sorry, late to the party but does this work?

Code:
Sub ExportSheetsAsText()
Dim ws As Worksheet, wsName As String
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
    wsName = ws.Name
    ws.Copy
    ActiveWorkbook.SaveAs wsName & ".txt", xlUnicodeText
    ActiveWorkbook.Close savechanges:=False
Next ws
Application.DisplayAlerts = True
End Sub
 
Last edited:
Upvote 0
AB, thank you so much for bothering with me! IT WORKS! This is so great, I so much appreciate your help!!!!!!

VoG II, thank you, too! This also works, but gets stuck on hidden worksheets. Ln 6, Col 1, and doesn't save an xls copy of the entire workbook. But I guess I can try to copy relevant code from AB.

Guys, thank you so very much!!! This macro is a part of a project which was totally falling apart without it. Can't wait till tomorrow to implement the thing and run the project for the first time! THANK YOU!
 
Upvote 0
Great...let us know. Looking at VOG II's code its basically the same procedure as mine so I think we're in line on that (I've got all this other stuff going on with file management, I guess).

It does remind me of one thing:

My routine saves as xlText, VOG II's as xlUnicodeText, and another common option is xlCSV...

In other words, there are slightly differing formats available for text files, so let us know if there are any problems with the way the text files are saved.

AB
 
Upvote 0
To get around the problem with hidden sheets try

Code:
Sub ExportSheetsAsText()
Dim ws As Worksheet, wsName As String, vis As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    wsName = ws.Name
    vis = ws.Visible
    ws.Visible = xlSheetVisible
    ws.Copy
    ws.Visible = vis
    ActiveWorkbook.SaveAs wsName & ".txt", xlUnicodeText
    ActiveWorkbook.Close savechanges:=False
Next ws
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

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
Back
Top