2015-04-26 3 views
0

У меня есть база данных в MS Access с информацией о контактах и ​​отдельной папкой со всеми фотографиями. Я хотел бы создать vcf-карты со встроенными изображениями. Код для извлечения информации из базы данных и для чтения изображения работает, но код для создания карты не (возможно, из-за base64). Не могли бы вы помочь мне?Создать карту VCF с изображением в vba

Private Function encodeBase64(ByRef arrData() As Byte) As String 

Dim objXML As Object 
Dim objNode As Object 

Set objXML = CreateObject("MSXML2.DOMDocument") 
Set objNode = objXML.createElement("Base64Data") 
objNode.DataType = "bin.base64" 
objNode.nodeTypedValue = arrData 
encodeBase64 = objNode.text 

Set objNode = Nothing 
Set objXML = Nothing 

End Function 

Private Sub createVCF() 

Dim objXML As Object 
Dim objNode As Object 
Dim encode As String 
Dim image_bin() As Byte 

'read image 
file = CurrentProject.Path & "\" & "photo.jpg" 
Open file For Binary Access Read As #1 
ReDim image_bin(LOF(1) - 1) 
Get #1, , image_bin 
Close #1 

'encode 
encode = encodeBase64(image_bin) 

'create vcf 
Open CurrentProject.Path & "\" & "card_test.vcf" For Append Access Write As 2 
Print #2, "BEGIN:VCARD" 
Print #2, "VERSION:3.0" 
Print #2, "N;CHARSET=WINDOWS-1252;ENCODING=QUOTED-PRINTABLE:;" & "Doe" & ";" & "John" & ";;;;;" 
Print #2, "NAME;CHARSET=WINDOWS-1252;ENCODING=QUOTED-PRINTABLE:" & "John" & " " & "Doe" 
Print #2, "NOTE;CHARSET=WINDOWS-1252;ENCODING=QUOTED-PRINTABLE:" & "From MS Access" 
Print #2, "TEL;Work:" & "1234" 
Print #2, "TEL;Cell:" & "4321" 
Print #2, "EMAIL;Work:" & "[email protected]" 
Print #2, "ADR;WORK:;;" & "Building A" & " - " & "2B" & ";;;;" 
Print #2, "PHOTO;ENCODING=BASE64:" & encode 
Print #2, "END:VCARD" 
Close #2 

Set objNode = Nothing 
Set objXML = Nothing 
End Sub 

Спасибо, Arno

+0

Можете ли вы уточнить, где именно проблема в вашем коде? –

+0

Outlook не показывает картинку при открытии vcard – Arno

ответ

0

Как указано в спецификации VCard, вам нужно добавить ведущее место в каждой сложенной (обернутые) строки в файле VCard. https://tools.ietf.org/html/rfc6350#section-3.2

Это относится к данным изображения Base64 в этом случае.

Для этого замените весь LF (перевод строки) в данных Base64 на LF, а затем пробел.

'encode 
encode = Replace(encodeBase64(image_bin), vbLf, vbCrLf & Space(1)) 

В то время как мы в этом, код заменяет LF с CRLF тоже, как это то, что просит спек. - Хотя это не имеет никакого отношения к Outlook.

+0

Работает. Это имеет значение в отношении Outlook. Большое спасибо. – Arno