A macro do Excel transforma o arquivo Unicode em CSV codificado em UTF-8

0

Eu tenho uma tarefa na qual preciso exportar cada planilha de uma pasta de trabalho no Excel como seu próprio arquivo .csv com a codificação utf-8. A maneira que eu era originalmente apontada para fazer isso era salvar cada um como texto unicode e, em seguida, pós-processá-los e substituir todos os delimitadores de tabulação por vírgulas. Eu tenho o seguinte código que me faz parte do caminho até lá. Ele falha com o código de erro 3002 quando tenta fazer BinaryStream.LoadFromFile FileName . Pelo que descobri, é porque o arquivo já deve estar aberto no Excel e, como tal, a função não pode ser carregada no fluxo ADODB. Além disso estou bastante preso. Qualquer ajuda para resolver isso seria muito apreciada!

Public Sub ExportSheetsToCSV()

Dim wsExport As Worksheet
Dim wbkExport As Workbook
Dim fileLoc As String

fileLoc = selectDialog() 'Function which allows the user to select the location from a browser window
'fileLoc = "h:\test\"

For Each wsExport In Worksheets
wsExport.Select
nm = wsExport.Name
If Not IsActiveSheetEmpty() Then
    Rows("1:1").Select 'deletes header line
    Selection.Delete Shift:=xlUp
    ActiveSheet.SaveAs FileName:=fileLoc & "\" & nm & ".txt", FileFormat:=xlUnicodeText
    readAndReplace (fileLoc & "\" & nm)
    Application.DisplayAlerts = True
End If

Next wsExport
End Sub
Private Sub readAndReplace(fileNameRead As String)

Dim pos1 As Long, pos2 As Long, i As Long
Dim fileWrite As String, line As String, fileNameWrite As String
Dim writeStream As Object

        fileWrite = Replace(ReadTextFile(fileNameRead), vbTab, ",")

        Set writeStream = CreateObject("ADODB.Stream")
        writeStream.Type = 2
        writeStream.CharSet = "utf-8"
        writeStream.Open
        writeStream.WriteText fileWrite
        writeStream.SaveToFile fileNameWrite, 2

End Sub
'Function from "http://www.motobit.com/tips/detpg_read-write-binary-files/"
Function ReadTextFile(FileName)
  Const adTypeText = 2

  'Create Stream object
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To get binary data.
  BinaryStream.Type = adTypeText

  'Specify charset For the source text (unicode) data.
  'If Len(CharSet) > 0 Then
    'BinaryStream.CharSet = CharSet
  'End If

  BinaryStream.CharSet = "utf-8"

  'Open the stream
  BinaryStream.Open

  'Load the file data from disk To stream object
  BinaryStream.LoadFromFile FileName

  'Open the stream And get binary data from the object
  ReadTextFile = BinaryStream.ReadText
End Function
    
por Jason Blocklove 11.08.2017 / 21:44

0 respostas