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

Inline image 1

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:

TagsVBA, Excel, convert, text, to text, planilha, sheet, worksheet, 

Nenhum comentário:

Postar um comentário

diHITT - Notícias