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
Respuesta
1

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...

1 respuesta más de otro experto

Respuesta
2

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas