Можно и самому написать конвертор.
Писал на коленке.
Протестируете и заточите под себя.Функцию чтения файла сообразите сами
Скрытый текст |
---|
Код |
---|
Sub Test()
s = Read_Text("C:\Users\Сергей\Desktop\Контакты.vcf")
matches = Split(s, "BEGIN:VCARD")
For n = 1 To UBound(matches)
s = matches(n)
s = DecodeQuotedPrintables(s)
Next
End Sub
Function DecodeQuotedPrintables(inp) As String
Dim varByteArray(1) As Byte
inp = UCase(inp)
inp = Replace(inp, "CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:", "")
Static RegExp As Object
If RegExp Is Nothing Then
Set RegExp = CreateObject("VBScript.RegExp")
End If
RegExp.Global = True
RegExp.MultiLine = True
RegExp.Pattern = "=([A-Z][0-9A-Z])=([0-9A-Z]{2})"
Set oMatches = RegExp.Execute(inp)
For n = 0 To oMatches.Count - 1
varByteArray(0) = Val("&H" & oMatches(n).subMatches(0))
varByteArray(1) = Val("&H" & oMatches(n).subMatches(1))
char$ = ConvertBytesToString(varByteArray)
inp = Replace(inp, oMatches(n).Value, char$)
Next
RegExp.Pattern = "=[0-9A-Z]{2}"
Set oMatches = RegExp.Execute(inp)
For n = 0 To oMatches.Count - 1
Vr = Val("&H" & Mid(oMatches(n).Value, 2))
char$ = Chr(Vr)
inp = Replace(inp, oMatches(n).Value, char$)
Next
inp = Replace(inp, "CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:", "")
inp = Replace(inp, "=", "")
DecodeQuotedPrintables = inp
End Function
Function ConvertBytesToString(varByteArray)
Static byt As Object
Const adTypeText = 2
Const adTypeBinary = 1
On Error GoTo ConvertBytesToString_Error
If byt Is Nothing Then
Set byt = CreateObject("ADODB.Stream")
End If
byt.Type = adTypeBinary
byt.Open
byt.Write varByteArray
byt.Position = 0
byt.Type = adTypeText
byt.charSet = "utf-8"
ConvertBytesToString = byt.ReadText
byt.Close
On Error GoTo 0
Exit Function
ConvertBytesToString_Error:
End Function
|
|
PS:Проверил, работает