Question

我在MS Access中有一个数据库，其中包含联系人信息和包含所有图片的单独文件夹。我想创建带嵌入图片的vcf卡。从数据库中提取信息并读取图片的代码有效，但创建卡的代码却没有（可能是因为base64）。你能帮帮我吗？

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:" & "john.doe@doe.com"
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

Answer 1

如VCard规范中所述，您需要为VCard文件中的每个折叠（包裹）行添加前导空格。 https://tools.ietf.org/html/rfc6350#section-3.2

在这种情况下，这适用于您的Base64图像数据。

要实现用Base替换Base64数据中的所有LF（换行符），后跟空格。

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

虽然我们在这里，但代码也将CR替换为CRLF，因为这是规范所要求的。 - 虽然它对Outlook没有任何影响。

在vba中创建带有图片的VCF卡

1 个答案: