Hi
I am new in excel vba macros and programming. My problem is, that I want to export data from *.csv to vcf in UTF-8 encoding. My macro is running and export is working fine, but my problem is to set up encoding format of output csv. It is coded in ANSI. How to encode output vcf to UTF-8. Here is macro:
Sub makro()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Dim sPath As String
Dim i As Integer
Dim sBegin, sVersion, sEnd, sUID As String
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim ViewMode As Long
On Error Resume Next
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "B")
If Not IsError(.Value) Then
If .Value = "5001" Then .EntireRow.Delete
End If
End With
Next Lrow
End With
MkDir "C:\Kontakty_sRWE\"
MkDir ("C:\Kontakty_sRWE\" & Format(Date, "MM-DD-YYYY") & "\")
sPath = "C:\Kontakty_sRWE\" & Format(Date, "MM-DD-YYYY") & "\"
sBegin = "BEGIN:VCARD" & vbCrLf
sVersion = "VERSION:3.0" & vbCrLf
sEnd = "END:VCARD" & vbCrLf
Lastrow = Range("A65536").End(xlUp).Row
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 1 To Lastrow
fs.CreateTextFile sPath & Range("A" & i) & ".vcf"
Set f = fs.OpenTextFile(sPath & Range("A" & i) & ".vcf", ForWriting, TristateTrue)
f.Write sBegin
f.Write sVersion
f.Write "FN:" & Range("A" & i) & vbCrLf
f.Write "N:" & Range("A" & i) & ";RWE;;;" & vbCrLf
f.Write "EMAIL;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
f.Write "TEL;TYPE=CELL:" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=WORK:3" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=WORK" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=CELL:" & Range("C" & i) & vbCrLf
f.Write "ORG:" & vbCrLf
f.Write sEnd
f.Close
Next i
MkDir "C:\Kontakty_bezRWE\"
MkDir ("C:\Kontakty_bezRWE\" & Format(Date, "MM-DD-YYYY") & "\")
sPath = ("C:\Kontakty_bezRWE\" & Format(Date, "MM-DD-YYYY") & "\")
sBegin = "BEGIN:VCARD" & vbCrLf
sVersion = "VERSION:3.0" & vbCrLf
sEnd = "END:VCARD" & vbCrLf
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 1 To Lastrow
fs.CreateTextFile sPath & Range("A" & i) & ".vcf"
Set f = fs.OpenTextFile(sPath & Range("A" & i) & ".vcf", ForWriting, TristateFalse)
f.Write sBegin
f.Write sVersion
f.Write "FN:" & Range("A" & i) & vbCrLf
f.Write "N:" & Range("A" & i) & ";RWE;;;" & vbCrLf
f.Write "EMAIL;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
f.Write "TEL;TYPE=CELL:" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=WORK:3" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=WORK:" & Range("B" & i) & vbCrLf
f.Write "TEL;TYPE=CELL:" & Range("C" & i) & vbCrLf
f.Write "ORG:" & vbCrLf
f.Write sEnd
f.Close
Next i
End Sub
thank for you help
Bookmarks