2016-08-26 5 views
2

Я работаю над написанием сценария для генерации отчетов, для которых требуется 80-байтовый формат строки.
В настоящее время мой скрипт корректно форматирует все поля, объединяет их в один столбец и удаляет остальные. Этот конкатенированный столбец имеет пробелы, разделяющие поля, которые нельзя отбрасывать при сохранении. Все это делается в 64-разрядной версии Excel 2016 в Windows 10.
Как я могу сохранить файл в виде текстового файла с кодировкой UTF-8?Сохранение листа в TXT с кодировкой UTF-8

+0

Убедитесь, что «ScriptUtils.ByteArray» находится в списке ссылок. Инструменты: -> Ссылки и поиск ScriptUtils.ByteArray – HA560

+1

@ HA560 благодарит за это. Я получил скрипт из [здесь] (http://www.motobit.com/help/scptutl/cm119.htm) и только понял, что я должен установить их [ScriptUtilities] (http: //www.motobit. com/help/scptutl/default.htm). EDIT: Дерьмо. Это стоит денег. – drdb

+0

Вы можете создавать байтовые массивы в vba без купленной утилиты. Множество примеров с использованием StrConv, vbUnicode и массивов типа Byte. – dbmitch

ответ

0

В итоге я написал сценарий AHK, который открывает Notepad ++, изменяет кодировку, сохраняет файл и закрывает его. Не такой элегантный, как я бы надеялся, но он выполняет свою работу.

+0

Обновлен код в ответ - работает для Office 64 бит – dbmitch

+0

Удивительный! Я попробую. – drdb

0

Вот код из этого образца таблицы модифицирована для офиса 64 бит

UTFTest.bas

' Converting a VBA string to an array of bytes in UTF-8 encoding 

' $Date: 2015-06-30 10:05Z $ 
' $Original Author: David Ireland $ 

' Copyright (C) 2015 DI Management Services Pty Limited 
' <http://www.di-mgt.com.au> <http://www.cryptosys.net> 

Option Explicit 
Option Base 0 

''' Extract a set of VBA "Unicode" strings from Excel sheet, encode in UTF-8 and display details 
Public Sub ShowStuff() 
    Dim strData As String 

    ' Plain ASCII 
    ' "abc123" 
    ' U+0061, U+0062, U+0063, U+0031, U+0032, U+0033 
    ' EXCEL: Get value from cell A1 
    strData = Worksheets("Sheet1").Cells(1, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(1, 2) 
    ProcessString (strData) 

    ' Spanish 
    ' LATIN SMALL LETTER[s] [AEIO] WITH ACUTE and SMALL LETTER N WITH TILDE 
    ' U+00E1, U+00E9, U+00ED, U+00F3, U+00F1 
    ' EXCEL: Get value from cell A3 
    strData = Worksheets("Sheet1").Cells(3, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(3, 2) 
    ProcessString (strData) 

    ' Japanese 
    ' "Hello" in Hiragana characters is KO-N-NI-TI-HA (Kon'nichiwa) 
    ' U+3053 (hiragana letter ko), U+3093 (hiragana letter n), 
    ' U+306B (hiragana letter ni), U+3061 (hiragana letter ti), 
    ' and U+306F (hiragana letter ha) 
    ' EXCEL: Get value from cell A5 
    strData = Worksheets("Sheet1").Cells(5, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(5, 2) 
    ProcessString (strData) 

    ' Chinese 
    ' CN=ben (U+672C), C= zhong guo (U+4E2D, U+570B), OU=zong ju (U+7E3D, U+5C40) 
    ' EXCEL: Get value from cell A7 
    strData = Worksheets("Sheet1").Cells(7, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(7, 2) 
    ProcessString (strData) 

    ' Hebrew 
    ' "abc" U+0061, U+0062, U+0063 
    ' SPACE U+0020 
    ' [NB right-to-left order] 
    ' U+05DB HEBREW LETTER KAF 
    ' U+05E9 HEBREW LETTER SHIN 
    ' U+05E8 HEBREW LETTER RESH 
    ' SPACE "f123" U+0066 U+0031 U+0032 U+0033 
    ' EXCEL: Get value from cell A9 
    strData = Worksheets("Sheet1").Cells(9, 1) 
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(9, 2) 
    ProcessString (strData) 

End Sub 

Public Function ProcessString(strData As String) 
    Dim abData() As Byte 
    Dim strOutput As String 

    Debug.Print strData ' This should show "?" for non-ANSI characters 

    strOutput = Utf8BytesFromString(strData) 

    abData = strOutput 
    ' Reset array width to Actual Number of Bytes 
    ReDim Preserve abData(Len(strOutput) - 1) 

    Debug.Print bv_HexFromBytesSp(abData) 

    Debug.Print "Strlen=" & Len(strData) & " chars; utf8len=" & Len(strOutput) & " bytes" 

End Function 

''' Returns hex-encoded string from array of bytes (with spaces) 
''' E.g. aBytes(&HFE, &HDC, &H80) will return "FE DC 80" 
Public Function bv_HexFromBytesSp(aBytes() As Byte) As String 
    Dim i As Long 

    If Not IsArray(aBytes) Then 
     Exit Function 
    End If 

    For i = LBound(aBytes) To UBound(aBytes) 
     If (i > 0) Then bv_HexFromBytesSp = bv_HexFromBytesSp & " " 
     If aBytes(i) < 16 Then 
      bv_HexFromBytesSp = bv_HexFromBytesSp & "0" & Hex(aBytes(i)) 
     Else 
      bv_HexFromBytesSp = bv_HexFromBytesSp & Hex(aBytes(i)) 
     End If 
    Next 

End Function 

И Win64 API преобразуются вызовы

' basUtf8FromString 

' Written by David Ireland DI Management Services Pty Limited 2015 
' <http://www.di-mgt.com.au> <http://www.cryptosys.net> 

Option Explicit 

' CodePage constant for UTF-8 
Private Const CP_UTF8 = 65001 

#If Win64 Then 

    Private Declare PtrSafe Function GetACP Lib "Kernel32"() As LongPtr 

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As LongPtr, _ 
     ByVal dwflags As LongPtr, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, _ 
     ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As LongPtr 

    Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As LongPtr, _ 
     ByVal dwflags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, _ 
     ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, _ 
     lpUsedDefaultChar As LongPtr) As LongPtr 

#Else 

    Private Declare PtrSafe Function GetACP Lib "Kernel32"() As Long 

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, _ 
     ByVal dwflags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _ 
     ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long 

    Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, _ 
     ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _ 
     ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, _ 
     lpUsedDefaultChar As Long) As Long 

#End If 

''' Return byte array with VBA "Unicode" string encoded in UTF-8 
Public Function Utf8BytesFromString(strInput As String) As String 
    Dim nBytes  As LongPtr 
    Dim pwz   As LongPtr 
    Dim pwzBuffer As LongPtr 

    Dim sBuffer  As String 

    ' Get length in bytes *including* terminating null 
    pwz = StrPtr(strInput) 
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&) 

    sBuffer = String$(nBytes + 1, vbNullChar) 
    pwzBuffer = StrPtr(sBuffer) 

    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, pwzBuffer, Len(sBuffer), ByVal 0&, ByVal 0&) 
    Utf8BytesFromString = Left$(sBuffer, nBytes - 1) 
End Function 

Как извлечена из http://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html