Guardar caracteres Unicode en un archivo desde campos de su base de datos de Access

VBA

Módulo estándar

'*************** Code Start *****************************************************
' Purpose  : Create (or replace) a file with Unicode characters using ADODB.Stream
' Author   : crystal (strive4peace)
' This code: 
' Code List: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk
'---------------------------------------------------------------------------------------
'                              File_SaveUnicode_s4p
'---------------------------------------------------------------------------------------
'
Public Sub File_SaveUnicode_s4p() 
' create a file with Unicode characters directly from fields
'  the Translation field might have Unicode characters
' file is created in CurrentProject.Path
   On Error GoTo Proc_Err 
   
   Dim sSQL As String _ 
      ,sPathFile As String _ 
      ,sMsg As String 

   Dim db As DAO.Database _ 
      ,rs As DAO.Recordset 
      
   'early binding
   '  Microsoft ActiveX Data Objects 6.1 Library
   ' Dim MyStream As ADODB.Stream
   'late binding
   Dim MyStream As Object  'ADODB.Stream
   Set MyStream = CreateObject( "ADODB.Stream") 
   
   sPathFile = CurrentProject.Path &  "\MerryChristmas_DifferentLanguages.txt"
   'delete file if it already exists
   If Dir(sPathFile)   "" Then 
      Kill sPathFile 
      DoEvents 
   End If 

   sSQL =  "SELECT T.PhraseID" _ 
      &  ", L.Languag" _ 
      &  ", T.Translation" _ 
      &  ", L.pReadingOrder" _ 
      &  " FROM tLanguages AS L " _ 
      &  " INNER JOIN tTranslation AS T ON L.LangID = T.LangID" _ 
      &  " WHERE(T.PhraseID = 1)" _ 
      &  " ORDER BY L.Languag;"

   Set db = CurrentDb 
   Set rs = db.OpenRecordset(sSQL,dbOpenDynaset) 
      
   With MyStream 
      .Type = 2  'adTypeText
      .Charset =  "utf-8"
      .Open 
      .WriteText  "-- Merry Christmas in different languages --"
      .WriteText Chr(13) & Chr(10) 
      'loop through records
      Do While Not rs.EOF 
         'space and then language
         .WriteText Space(5) & rs!Languag 'could have used a string variable for this
         'new line
         .WriteText Chr(13) & Chr(10) 
         'translation and then another new line
         .WriteText rs!Translation 'THIS is why the ADO stream is needed! 
         .WriteText Chr(13) & Chr(10) 
         rs.MoveNext 
      Loop 
      rs.Close 
      'save and close the file
       .SaveToFile sPathFile 
       .Close 
   End With  'MyStream
   
   sMsg = sPathFile &  " is created, " _ 
      & vbCrLf &  "Do you want to open it?"
      
   If MsgBox(sMsg,vbYesNo, "Open File?") = vbYes Then 
      Call Shell( "Explorer.exe" &  " " & sPathFile,vbNormalFocus) 
   End If 

Proc_Exit: 
   On Error Resume Next 
   'release object variables
   If Not rs Is Nothing Then 
      rs.Close 
      Set rs = Nothing 
   End If 
   Set db = Nothing 
   Set MyStream = Nothing 
   Exit Sub 
  
Proc_Err: 
   MsgBox Err.Description,,_ 
        "ERROR " & Err.Number _ 
        &  "   File_SaveUnicode_s4p "

   Resume Proc_Exit 
   Resume 
End Sub 
'*************** Code End *******************************************************

El código se generó con colores utilizando el complemento gratuito Color Code para Access