Hola usuario de nuestra página web, encontramos la respuesta a tu pregunta, desplázate y la verás a continuación.
Ejemplo: Excel vba guardar hoja en CSV con codificación UTF 8
'VBA routine to save the currently active worksheet to a CSV file'without losing focus AND retaining Unicode characters. This routine'is extremely fast (instantaneous) and produces no flicker:Sub SaveSheetAsCSV()Dim i&, j&, iMax&, jMax&, chk$, listsep$, s$, v
Const Q ="""", QQ = Q & Q
listsep = Application.International(xlListSeparator)
chk = Q &","& listsep &","& vbLf
With ActiveSheet
v =.UsedRange.Value
iMax = UBound(v,1): jMax = UBound(v,2)For i =1To iMax
For j =1To jMax
IfNot IsError(v(i, j))Then s = v(i, j)Else s =.Cells(i, j).Text
If AnyIn(s, Q, listsep, vbLf)Then s = Replace(s, Q, QQ): s = Q & s & Q
BuildString s & listsep
NextIf i < iMax Then BuildString vbCrLf,-1Next
s =.Parent.Path & Application.PathSeparator & Left(.Parent.Name, InStrRev(.Parent.Name,"."))&.Name &".csv"
SaveStringAsTextFile BuildString(Done:=True, Adjust:=-1), s
EndWithEndSubFunction BuildString(Optional txt$,Optional Adjust&,Optional Done AsBoolean,Optional Size ="20e6")Static p&, s$If Len(p)Then p = p + adjust
If Done Then BuildString = Left(s, p -1): p =0: s ="":ExitFunctionIf p =0Then: p =1: s = Space(Size)
Mid$(s, p, Len(txt))= txt
p = p + Len(txt)EndFunctionFunction AnyIn(s$,ParamArray checks())AsBooleanDim e
ForEach e In checks
If InStrB(s, e)Then AnyIn =True:ExitFunctionNextEndFunctionFunction SaveStringAsTextFile$(s$, fName$)Const adSaveCreateOverWrite =2With CreateObject("ADODB.Stream").Charset ="utf-8".Open
.WriteText s
.SetEOS
.SaveToFile fName, adSaveCreateOverWrite
.Close
EndWithEndFunction
Aquí puedes ver las comentarios y valoraciones de los usuarios
Tienes la opción de confirmar nuestra misión ejecutando un comentario y puntuándolo te lo agradecemos.
¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)