How can I create text files with special character

Question

Demonstration of my problem

• Open a new Excel workbook and save these symbols 設計師協會 to cell [A1]
• insert the following VBA code somewhere in the editor (Alt+F11)
• execute it line per line (F8)

Sub test()

    strCRLF = StrConv(vbCrLf, vbUnicode)
    strSpecialchars = StrConv(Cells(1, 1), vbUnicode)
    strFilename = "c:\test.txt"

    Open strFilename For Output As #1
    Print #1, strSpecialchars & strCRLF;
    Close #1

End Sub

You will get a textfile which contains the chinese characters from [A1]. This proofs that VBA is able to handle unicode characters if you know the trick with adding StrConv(vbCrLf, vbUnicode)

Now try the same for strFilename = "C:\" & strSpecialchars & ".txt". You will get an error that you can't create a file with this filename. Of course you can't use the same trick adding a new line since its a filename.

How can I create text files with special characters in their filenames using VBA?
Is there a work-around or am I doing something wrong?

Note

• I'm using Windows 7 x64. I'm able to create text files with special characters manually
• I found a second method using FileSystemObject. But I hope I could avoid setting a reference to the VB script run-time library

Answer 1

You are on the right track with the FileSystemObject. As Morbo mentioned you can late bind this so no reference is set. The FSO has a CreateTextFile function which can be set in unicode so the characters will appear as '??????' in VBA but will write correctly to the filename. Note the second parameter of the CreateTextFile function specifies a unicode string for the filename. The following will do the trick for you:

Sub test()
    Dim strCRLF As String, strSpecialchars As String, strFilename As String
    Dim oFSO As Object, oFile As Object

    strCRLF = StrConv(vbCrLf, vbUnicode)
    strSpecialchars = StrConv(Cells(1, 1), vbUnicode)
    strFilename = "C:\" & Cells(1, 1).Value & ".txt"

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.CreateTextFile(strFilename, , True)

    oFile.Write strSpecialchars & strCRLF

    oFile.Close

    Set oFile = Nothing
    Set oFSO = Nothing
End Sub

Answer 2

Value retrieved from the cell is already in Unicode.

StrConv(vbUnicode) gives you "double unicode" which is broken because it went through a conversion using the current sustem codepage.
Then the Print command converts it back to "single unicode", again using the current system codepage. Don't do this. You're not saving unicode, you're saving invalid something that may only appear valid on your particular computer under your current settings.

If you want to output Unicode data (that is, avoid the default VB mechanism of auto-converting output text from Unicode to ANSI), you have several options.

The easiest is using FileSystemObject without trying to invent anything about unicode conversions:

With CreateObject("Scripting.FileSystemObject")
  With .CreateTextFile("C:\" & Cells(1).Value & ".txt", , True)
    .Write Cells(1).Value
    .Close
  End With
End With

Note the last parameter that controls Unicode.

If you don't want that, you can declare CreateFileW and WriteFile functions:

Private Declare Function CreateFileW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As Any) As Long

Private Const CREATE_ALWAYS As Long = 2
Private Const GENERIC_WRITE As Long = &H40000000

Dim hFile As Long
hFile = CreateFileW(StrPtr("C:\" & Cells(1).Value & ".txt"), GENERIC_WRITE, 0, ByVal 0&, CREATE_ALWAYS, 0, 0)

Dim val As String
val = Cells(1).Value

WriteFile hFile, &HFEFF, 2, 0, ByVal 0&  'Unicode byte order mark (not required, but to please Notepad)
WriteFile hFile, ByVal StrPtr(val), Len(val) * 2, 0, ByVal 0&

CloseHandle hFile