Full Version: Saving multiple excel files to text
UtterAccess Discussion Forums > Microsoft® Office > Microsoft Excel
orion6
Hi all,

I have a bunch of excel files that I needed to save as to tab delimited text files. Opening each one and then trying to save them individually will take me forever. I was wondering if there was some code that I could use to do this task.

I tried creating a macro but the trouble I'm having is with the filename for the new text file. I want it to be the same as the excel file but with a .txt extension instead of a .xls.

Would appreciate any help I can get. Thanks.
Luceze
What version of Excel are you using?
orion6
Hi Eric,

I should have specified that before... Excel 2003.

- O
Luceze
Hey O,

Give this a try.

CODE
[color="blue"]Sub[/color] SaveAsText()

        Application.DisplayAlerts = [color="blue"]False[/color]

        Application.ScreenUpdating = [color="blue"]False[/color]

    [color="blue"]Dim[/color] fd [color="blue"]As[/color] FileDialog

    [color="blue"]Dim[/color] strFile [color="blue"]As[/color] [color="blue"]String[/color]

    [color="blue"]Dim[/color] lngCalc [color="blue"]As[/color] [color="blue"]Long[/color]

    [color="blue"]Dim[/color] wbCurrent

        lngCalc = Application.Calculation

        Application.Calculation = xlCalculationManual

        [color="blue"]Set[/color] fd = Application.FileDialog(msoFileDialogFolderPicker)

            [color="blue"]With[/color] fd

                [color="blue"]If[/color] .Show = -1 [color="blue"]Then[/color]

                    strDir = .SelectedItems(1)

                    Else: [color="blue"]GoTo[/color] res_exit

                [color="blue"]End[/color] [color="blue"]If[/color]

            [color="blue"]End[/color] [color="blue"]With[/color]

    

        strFileName = Dir(strDir & "\", vbNormal)

    

        [color="blue"]Do[/color] [color="blue"]While[/color] [color="blue"]CBool[/color](Len(strFileName))

            [color="blue"]If[/color] Right(strFileName, 4) = ".xls" [color="blue"]Then[/color]

                [color="blue"]Set[/color] wbCurrent = Workbooks.Open(strDir & "\" & strFileName)

                wbCurrent.SaveAs Filename:= _

                strDir & Left(wbCurrent.Name, Len(wbCurrent.Name) - 3) & "txt", FileFormat:=xlText

                wbCurrent.Close

            [color="blue"]End[/color] [color="blue"]If[/color]

            strFileName = Dir

        [color="blue"]Loop[/color]

res_exit:

        Application.Calculation = lngCalc

        Application.ScreenUpdating = [color="blue"]True[/color]

        Application.DisplayAlerts = [color="blue"]True[/color]

        [color="blue"]Set[/color] fd = [color="blue"]Nothing[/color]

        [color="blue"]Set[/color] wb = [color="blue"]Nothing[/color]

    [color="blue"]Exit[/color] [color="blue"]Sub[/color]

err_hand:

        MsgBox Err.Number & " " & Err.Description, vbCritical, "Error"

        [color="blue"]GoTo[/color] res_exit

[color="blue"]End[/color] [color="blue"]Sub[/color]


Edited by: Luceze on Wed Jun 14 13:07:03 EDT 2006.
orion6
Thanks Eric!!!

Worked beautifully!!

o!
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.