ник: Alex
Что-то совсем запутался и ничего не получается...
Есть таблица с полями: ХранитьКак (имя абонента), Контакт (телефон), Image (genm к файлу с фоткой JPG)
Нужно чтобы по нажатию кнопочки формировался текстовый файл такого содержания:
BEGIN:VCARD
VERSION:2.1
N;ХранитьКак
FN;ХранитьКак
TEL;CELL:Контакт
TEL;HOME:
TEL;WORK:
TEL;FAX:
PHOTO;ENCODING=BASE64;JPEG: < Закодированная фотка, находящаяся по пути Image >
END:VCARD
|
Для каждой записи в таблице - свой такой блок
Наваял во:
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function
Function VcfList()
Dim intNF As Integer
Dim bytB() As Byte
'Dim strFullFileName As String
Dim rs As DAO.Recordset
Dim fso As Object
Dim TextStream As Object
Dim i As Integer
Set rs = CurrentDb.OpenRecordset("çàïVCF")
rs.MoveLast: rs.MoveFirst
Set fso = CreateObject("Scripting.FileSystemObject")
Set TextStream = fso.CreateTextFile(CurrentProject.Path & "\List.vcf")
For i = 1 To rs.RecordCount
TextStream.WriteLine "BEGIN:VCARD"
TextStream.WriteLine "VERSION:2.1"
TextStream.WriteLine "N;" & rs.Fields("ХранитьКак")
TextStream.WriteLine "FN;" & rs.Fields("ХранитьКак")
TextStream.WriteLine "TEL;CELL:" & rs.Fields("Контакт")
TextStream.WriteLine "TEL;HOME:"
TextStream.WriteLine "TEL;WORK:"
TextStream.WriteLine "TEL;FAX:"
intNF = FreeFile
Open ("Image") For Binary Access Read As #intNF
ReDim bytB(FileLen("Image"))
Get #intNF, , bytB
Close #intNF
TextStream.WriteLine "PHOTO;ENCODING=BASE64;JPEG:" & EncodeBase64(bytB)
TextStream.WriteLine "END:VCARD"
TextStream.WriteBlankLines 2
If i < rs.RecordCount Then rs.MoveNext
Next i
TextStream.Close
Set TextStream = Nothing
Set fso = Nothing
Set rs = Nothing
MsgBox "Готово!"
End Function
|
Ниработаит :(