تحويل ملف اكسل الي vcard

[زهير العمير]

السلام عليكم

 

المنتدى و الاعضاء  الاحبة 

 

لدي  ملف  اكسل  يوجد  فيه  ارقام  جولالاتي   واريد  ان احول  صيغة  الملف  من اكسل  الي  صيغة     vcard   

 

ياريت الي عنده  طريقة او برناج  يحول  من  هذه  الصيغة الي  هذه  الصيغة      ,,,,        يفيدنا  واكون له من الشاكرين 

[ياسر خليل أبو البراء]

وعليكم السلام

أخي الكريم جرب الملف التالي (لم أجربه من قبل ...)

 

Excel To vCard.rar

[زياد عبد الجليل]

الاكسيلانس لديه الحل لكل المشاكل بارك الله فيك يا استاذ ياسر يا دكتور الاكسيل 

[ياسر خليل أبو البراء]

6 ساعات مضت, زياد777 said:

الاكسيلانس لديه الحل لكل المشاكل بارك الله فيك يا استاذ ياسر يا دكتور الاكسيل 

ربنا يبارك فيك ويكرمك أخي العزيز زياد

كله بفضل الله وحده .. وما أنا وإخواني في المنتدى إلا سبب جعله الله لكم لك لييسر أموركم ..

يسر الله أمورنا جميعاً ووفقنا لما يحب ويرضى

[زهير العمير]

لسى ما حصلت حل  يحولي  ملف الاكسل  الي  صيغة    vcard

[ياسر خليل أبو البراء]

9 دقائق مضت, زهير العمير said:

لسى ما حصلت حل  يحولي  ملف الاكسل  الي  صيغة    vcard

هل حربت الملف الذي أرفقته؟

ما هي المشكلة التي صادفتك بالتحديد؟

عموماً جرب الملف التالي عله يكون المفيد لك

Create VCF.rar

[زهير العمير]

شكرا  اخ  ياسر على اهتمامك  وردك  السريع

 

والله حاولت لكن  الطريقة  مش واضحة كثير  وخاصة  للمبدئين بالاكسل

[ياسر خليل أبو البراء]

أخي الكريم زهير

جرب الكود التالي عله يفي بالغرض إن شاء الله

Sub Create_VCF()
    Dim FileNum     As Integer
    Dim iRow        As Double
    Dim OutFilePath As String
    Dim fName       As String
    Dim lName       As String
    Dim PhNum       As String

    iRow = 2
    FileNum = FreeFile
    OutFilePath = ThisWorkbook.Path & "\Output.VCF"
    Open OutFilePath For Output As FileNum

    While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
        fName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
        lName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
        PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))

        Print #FileNum, "BEGIN:VCARD"
        Print #FileNum, "VERSION:3.0"
        Print #FileNum, "N:" & fName & ";" & lName & ";;;"
        Print #FileNum, "FN:" & fName & " " & lName
        Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
        Print #FileNum, "END:VCARD"
        iRow = iRow + 1
    Wend

    Close #FileNum
    MsgBox "Contacts Converted to Saved To: " & OutFilePath
End Sub

تقبل تحياتي

Convert Excel Contacts To VCF YasserKhalil Officena.rar