CODEWITHSUNDEEP
excelvbautf-8
kolis29
kolis29

Reputation: 113

Copy export file to text file as UTF-8 code

I've got the code bellow which copies content from excel worksheet and paste it to text file and saves it as html file. But I need to save it with UTF-8 coding. I've found some hints here http://www.ozgrid.com/forum/showthread.php?t=154957&p=560424#post560424 and here Save text file UTF-8 encoded with VBA but I cannot implement this code to mine. Can you please help me. Many thanks!

 Private Sub CommandButton1_Click()

 Dim FileNum As Integer, cl As Range, z As Integer, y As Integer, FName As String, FPath As String

 Dim myStr As String

 Dim fsT As Object


 FileNum = FreeFile ' next free filenumber

 'Open "C:\Temp\TEXTFILE.TXT" For Output As #FileNum ' creates the new file

 FPath = "D:\mk"
 FName = Sheets("Website_POI").Range("D2").Text & ".html"

 Open FPath & "\" & FName For Append As #FileNum

 Print #FileNum, [a4]

 z = 10

 For Each cl In [a4:x3000]

     y = cl.Row

     If y = z Then

         myStr = myStr & "" & cl

         'appends the input to an existing file write to the textfile

     Else: Print #FileNum, myStr

         z = cl.Row

         myStr = "": myStr = myStr & "" & cl

     End If

 Next


 'appends the input to an existing file write to the textfile

 Print #FileNum, myStr

 Close #FileNum ' close the file

 End Sub

Upvotes: 0

Views: 1772

Answers (1)

David Zemens
David Zemens

Reputation: 53623

Instead of using the I/O Print statement to write the file, use the ADODB.Stream object.

I don't think this is going to append on the existing file (if that is desired, will need to make some modifications), rather it will overwrite the existing file:

         myStr = "": myStr = myStr & "" & cl

     End If

 Next

 With CreateObject("ADODB.Stream")
      .Type = 2 'Specify stream type - we want To save text/string data.
      .Charset = "utf-8" 'Specify charset For the source text data.
      .Open 'Open the stream And write binary data To the object
      .WriteText myStr
      .SaveToFile FPath & "\" & FName, 2 'Save binary data To disk
 End With

 Close #FileNum 

 End Sub

Upvotes: 3

Related Questions