Простой VBA скрипт для преобразования таблицы excel телефонной базы контактов в файл .vcf11.11.2023 19:15

Недавно я пытался перекинуть свои контакты из старого Блекберри в телефон с Андроидом и меня постигла неудача — оказалось не существует инструментов для корректного преобразования одного формата в другой.

Тогда я решил преобразовать мои контакты, полученные из старого телефона, в таблицу excel, и с помощью несложного скрипта в VBA преобразовать её файл вида .vcf, который можно скормить любому современному телефону.

Таблица у меня получилась такого вида:

Пример таблицы excel с контактами

Пример таблицы excel с контактами

Public Sub vcard()

 Dim a(), i&, ii&, t
 Dim b As String, OutDir As String
 Dim fso As Object 'FileSystemObject
 Dim txt As Object 'TextStream
 
    a = [a1].CurrentRegion.Value
    b = "" ' Переменная, в которую мы будем собирать информацию в формате .vcf
        
    For i = 2 To UBound(a)
    
        b = b & "BEGIN:VCARD" & vbNewLine & "VERSION:2.1" & vbNewLine
        b = b & "FN:" & Cells(i, 1).Text & vbNewLine
        
        If Cells(i, 2).Text <> "" Then b = b & "EMAIL:" & Cells(i, 2).Text & vbNewLine
        If Cells(i, 3).Text <> "" Then b = b & "ADR:" & Cells(i, 3).Text & ", " & Cells(i, 4).Text & vbNewLine
        If Cells(i, 5).Text <> "" Then b = b & "TEL;HOME:" & Cells(i, 5).Text & vbNewLine
        If Cells(i, 6).Text <> "" Then b = b & "TEL;CELL;PREF:" & Cells(i, 6).Text & vbNewLine
        If Cells(i, 7).Text <> "" Then b = b & "TEL;WORK:" & Cells(i, 7).Text & vbNewLine
        If Cells(i, 8).Text <> "" Then b = b & "ORG:" & Cells(i, 8).Text & vbNewLine
        If Cells(i, 9).Text <> "" Then b = b & "TITLE:" & Cells(i, 9).Text & vbNewLine
        If Cells(i, 10).Text <> "" Then b = b & "NOTE:" & Cells(i, 10).Text & vbNewLine

        b = b & "END:VCARD" & vbNewLine
        
    Next


OutDir = "C:\out\" 'Папка, в которую сохраним полученный файл

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile(OutDir & "out.vcf", 1, 1) 'Последний параметр - Unicode
     
    txt.WriteLine b
 
    txt.Close


End Sub

Код перебирает строки и ячейки и если находит информацию в соответствующих ячейках создаёт соответствующую строчку в файле .vcf.

Вы можете сформировать другую табличку в exsel и немого скорректировав скрипт сможете собрать свой файл .vcf.

Ничего сложного, но может кому-то понадобится.

© Habrahabr.ru