Save As CSV encoding UTF-8
Estoy con un problemita.
En la empresa utilizamos mailchimp para enviar campañas de Marketing. El problema es que la base de usuarios a enviar es bastante dinamica, por lo tanto tenemos que actualizar antes de enviar la campaña los usuarios.
Tengo una macro que refresca las conecciones y guarda los archivos en CSV para importarlo en mailchimp.
Al descargarlo en formato CSV no me reconoce las tildes ni Ñ ya que no los guarda con encoding by default UTF8.
¿Alguien sabe como podria hacer para que me los descargue en UTF-8 directamente desde la macro?.
La macro que tengo hasta ahora es
Sub Macro1()
Set Tool = Workbooks(ActiveWorkbook.Name)
Folder = ActiveWorkbook.Path
Set ConnectionSh = Sheets("Hoja1")
DateVal = Format(Date, "yy-mm-yyyy")
ConnectionSh.Copy
NewFileName = Folder & "\" & "Usuarios Activos GO5 (All Platforms) " & " LU_" & DateVal
ActiveWorkbook.WebOptions.Encoding = msoEncodingUTF8 'NO FUNCIONA
ActiveWorkbook.SaveAs Filename:=NewFileName, FileFormat:=xlCSV, CreateBackup:=False
NewWB = ActiveWorkbook.Name
Tool. Activate
Workbooks(NewWB). Close (False)
End Sub
2 respuestas
El problema persistía, pero conseguí resolverlo con otro código. Copio el mismo para
Importante: se requiere habilitar la librería "Microsoft ActiveX Data Objects 2.8 Lbrary"
Sub SaveAsUTF8()
Dim objStream As ADODB.Stream
Dim MiTexto As String
Set objStream = New ADODB.Stream
objStream.Open
objStream.Charset = "UTF-8"
NewFileName = ActiveWorkbook.Path & "\ARCHIVOUTF8"
SET ConnectionSh = Sheets("Hoja1")
ConnectionLR = ConnectionSh.Cells(ConnectionSh.Rows.Count, 1).End(xlUp).Row
MiTexto = ""
TextRow = 1
Do Until TextRow > ConnectionLR
MiTexto = MiTexto & ConnectionSh.Range("A" & TextRow).Value
MiTexto = MiTexto & "," & Application.Proper(ConnectionSh.Range("B" & TextRow).Value)
MiTexto = MiTexto & "," & Application.Proper(ConnectionSh.Range("C" & TextRow).Value)
MiTexto = MiTexto & "," & LCase(ConnectionSh.Range("D" & TextRow).Value)
MiTexto = MiTexto & "," & ConnectionSh.Range("E" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("F" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("G" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("H" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("I" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("J" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("K" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("L" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("M" & TextRow).Value
MiTexto = MiTexto & "," & ConnectionSh.Range("N" & TextRow).Value & vbCrLf
TextRow = TextRow + 1
Loop
objStream.WriteText MiTexto
objStream.SaveToFile NewFileName & ".csv"
objStream.Close
Set objStream = Nothing
End Sub
Por favor valorar la respuesta!
Slds
Juan
Yo le quitaría la opción de Encoding... No es necesario a no ser que el documento de origen venga con alguna codificación que no desees en el documento CSV exportado...
En el peor de los casos, cambia el formato de FileFormat por este otro: xlUnicodeText
Te quedaría algo como esto:
DateVal = Format(Date, "yy-mm-yyyy") ConnectionSh.Copy NewFileName = Folder & "\" & "Usuarios Activos GO5 (All Platforms) " & " LU_" & DateVal ActiveWorkbook.SaveAs Filename:=NewFileName, FileFormat:=xlUnicodeText, CreateBackup:=False NewWB = ActiveWorkbook.Name Tool. Activate Workbooks(NewWB). Close (False)
Saludos y espero que esto sea lo que necesitas...