Search code examples
vbatextunicodeflat-file

How to add FileSytemObject to my VBA for creating text flat files in Unicode?


I've managed to piece together this VBA which takes data from excel and turns it into .txt flat file. It works exactly as I need, but I would like to alter it so that the end result is saved as Unicode as opposed to ANSI.

I've done some reading and the answer I keep coming back to is to use FileSystemObject. I found a VBA on here that does the job perfectly, but I can't for the life of me work out how to incorporate it into my existing code. Any chance someone could throw me some pointers?

This is my current code:

' Defines everything first. So, from B2, across and down.
LastRow = Sheets("Pricing").Range("B" & Rows.Count).End(xlUp).Row
LastColumn = Sheets("Pricing").Cells(2, Columns.Count).End(xlToLeft).Column

' File name, path to save to and delimiter.
file = Sheets("Pricing").TextBox1 & ".txt"
If TextBox1.Value = "" Then MsgBox "What we calling it genius?", vbQuestion
If TextBox1.Value = "" Then Exit Sub

Path = "C:\Users\me.me\Desktop\Files\"
Delimeter = "|"

' The magic bit.

    myFileName = Path & file
    FN = FreeFile
    Open myFileName For Output As #FN

    For Row = 2 To LastRow

    For Column = 2 To LastColumn

        If Column = 2 Then Record = Trim(Cells(Row, Column)) Else Record = Record & Delimeter & Trim(Cells(Row, Column))

    Next Column

    Print #FN, Record

    Next Row

    Close #FN

MsgBox "BOOM! LOOKIT ---> " & myFileName

' Opens the finished file.
    
Dim fso As Object
Dim sfile As String
Set fso = CreateObject("shell.application")
sfile = "C:\Users\me.me\Desktop\Files\" & Sheets("Pricing").TextBox1 & ".txt"
fso.Open (sfile)

And this is what I've been trying to incorporate (HUGE thanks to MarkJ for posting this on another question):

   Dim fso As Object, MyFile As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set MyFile = fso.CreateTextFile("c:\testfile.txt", False,True) 'Unicode=True'
   MyFile.WriteLine("This is a test.")
   MyFile.Close

I just can't get it to work.


Solution

  • Please, test the next code. You did not answer my clarification question, but it works using the above comment assumptions. It take the file name, from an activeX text box situated on the sheet to be processed. The code should be faster than yours for big ranges, avoiding to iterate between all cells:

    Sub SaveAsUnicode()
      Dim shP As Worksheet, iRow As Long, Record As String, Delimeter As String
      Dim file As String, myFileName As String, path As String, txtB As MSForms.TextBox
      Dim rng As Range, lastCell As Range, arr, arrRow
      Dim fso As Object, MyFile As Object, shApp As Object
      
      Set shP = Worksheets("Pricinig")
      Set txtB = shP.OLEObjects("TextBox1").Object 'it sets an activeX sheet text box
      file = txtB.Text & ".txt"
      If txtB.value = "" Then MsgBox "What we calling it genius?", vbQuestion: Exit Sub
      
      Set lastCell = shP.cells.SpecialCells(xlCellTypeLastCell) 'last cell of the sheet
      Set rng = shP.Range("A2", lastCell)                       'create the range to be processed
      arr = rng.value                                           'put the range in an array
      
      path = "C:\Users\me.me\Desktop\Files\" 'take care to adjust the path!
      myFileName = path & file
      Delimeter = "|"
        
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set MyFile = fso.CreateTextFile(myFileName, False, True) 'open the file to write Unicode:
            For iRow = 1 To UBound(arr)                  'itereate between the array rows
                arrRow = Application.Index(arr, iRow, 0) 'make a slice of the currrent arrray row
                Record = Join(arrRow, Delimeter)         'join the iD obtained array, using the set Delimiter
                MyFile.WriteLine (Record)                'write the row in the Unicode file
            Next iRow
      MyFile.Close                                       'close the file
        
     'open the obtained Unicode file:
     Set shApp = CreateObject("shell.application")
     shApp.Open (myFileName)
    End Sub
    

    I tested the above code on a sheet using characters not supported in ANSI and it works as expected.

    Please, send some feedback after testing it, or if my assumptions after reading your question are not correct...