VBA Excel - Convertendo planilha Excel para arquivo texto - Convert Excel to Text file

| Blog Office VBA | Blog Excel | Blog Access |

Parece não haver por aí muitos códigos que demonstram como converter o conteúdo de planilhas em arquivos texto. Pelo menos não de forma reutilizável. Espero que este possa ajudar a muitos, especialmente os neófitos.

'Prompts for accepting user input

Let strViewPath = Trim (InputBox ("PLANILHA - Por favor, digite o path do arquivo",,"C:\Bernardes\"))

Let strTest = Trim (InputBox ("TEXTO - Por favor, digite o arquivo texo",,"sample"))

       

If Right (strViewPath, 1) <> "\" Then

   Let strViewPath = strViewPath & "\"   

End If       

Let strTestName = strTest
Let strTextFilePath = strViewPath

   

'Assign the values for the excel and text file that needs to be converted

Let TestToConvert = strViewPath + strTest + ".xls"
Let TextFile =strTextFilePath  + strTestName + ".txt"

   

'Create the excel object

Set oExcel = CreateObject("Excel.Application")

Let oExcel.Visible = False

'Open the excel file for conversion

Let oExcel.DisplayAlerts = False

oExcel.Workbooks.Open TestToConvert, True

'Call the text streamer function that will convert the file

TextStreamer TextFile, oExcel

 

'Exit the Excel file

oExcel.Quit

Private Sub TextStreamer(TextFileName, objExcel)

'Declare constants for reading,writing and appending to a text file

Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

   

Dim fs, f, ts, x, y, LastRow, LastColumn, c, objSheet, shts()

'Create the file system object for text file editing

Set fs = CreateObject("Scripting.FileSystemObject")

fs.CreateTextFile TextFileName

       

Set f = fs.GetFile(TextFileName)

Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

   

'Get the number of worksheets in the source excel file

Let intNoOfSheets = objExcel.Worksheets.count
Let z = intNoOfSheets

   

'Traverse through every sheet that needs to be converted

For i = 1 to intNoOfSheets

       

 'Activate the first worksheet

    objExcel.Worksheets(z).Activate

    objExcel.Worksheets(z).Select

    Set objSheet = objExcel.ActiveWorkbook.Worksheets(z)

    

    Let strSheetName = objsheet.name

    objSheet.Cells(1).Select

    Let LastRow = objSheet.UsedRange.Rows.Count + 2

    Let LastColumn = objSheet.UsedRange.Columns.Count   

                   

    objSheet.Cells(1).Select

                   

    ts.write "["&strSheetName&"]"

    ts.write Chr(13) & Chr(10)

           

    'Loop through the rows and columns in the excel worksheet and write the data to the text file       

    For x = 0 To LastRow

        For y = 0 To LastColumn -1

            If objExcel.ActiveCell.Offset(x, y).Value <> "" then

                ts.write (objExcel.ActiveCell.Offset(x, y).Value)

                'ts.write Chr(9)   

            End If

        Next

        ts.write Chr(13) & Chr(10)

    Next               

  

Let z= z-1

Next

       

'Close the excel file test streamer

ts.Close

msgbox "Conversion Complete!"

End Sub

Reference:

Aditya Kalra

Inspiration:

Tags: VBA, Excel, convert, text, to text, planilha, sheet, worksheet,