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
Tags csv microsoft-excel macros