How can I create text files with special characters in their filenames

后端 未结 2 501
一整个雨季
一整个雨季 2020-12-06 15:19

Demonstration of my problem

  • Open a new Excel workbook and save these symbols 設計師協會 to cell [A1]
  • insert the following VBA code somewhere in th
2条回答
  •  -上瘾入骨i
    2020-12-06 15:33

    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
    

提交回复
热议问题