بسم الله الرحمن الرحيم
اهلا بكم متابعى موقع عالم الاوفيس
حصريا ولاول مرة كود ترحيل البيانات من الاكسل الى الهاتف المحمول VCard For Android Or Iphone
درس مهم جدا جدا من دروس الاكسيل Excel VBA
دائما مايكون عندنا ملف اكسيل يحتوى على اسماء العملاء او الموردين او الموظفيين وفية بعض المعلومات الاخرى الخاصة بهم والتى من خلالها يتم التواصل معهم وهم ضمن جهات الاتصال طرفنا My Contact
مثل الاسم - الايميل - الشركة - الوظيفة - رقم التليفون - العنوان - رقم التليفون الاخر
وعايزين نرحل البيانات دى للعمل على الهاتف دة هيتم من خلال كود للحفظ بصيغة .VCF
سوف يتم ذلك من خلال هذا الكود
Sub export_to_vcard_new()
Dim fso, filepath
'filepath =
"C:\Users\EmadMohamedGhazi\Desktop\New folder\MyTestFile.vcf"
filepath =
ThisWorkbook.Path & "\ - vcard_new_ " & ".vcf"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream =
fso.CreateTextFile(filepath)
intRow = 3
strName =
ThisWorkbook.Sheets("Sheet1").Range("A" & intRow).Text
While strName <> ""
strFname =
Trim(ThisWorkbook.Sheets("Sheet1").Range("A" &
intRow).Text)
strEname =
Trim(ThisWorkbook.Sheets("Sheet1").Range("B" &
intRow).Text)
strComname =
Trim(ThisWorkbook.Sheets("Sheet1").Range("C" &
intRow).Text)
strJOPname =
Trim(ThisWorkbook.Sheets("Sheet1").Range("d" &
intRow).Text)
strphname = Trim(ThisWorkbook.Sheets("Sheet1").Range("e"
& intRow).Text)
stradename =
Trim(ThisWorkbook.Sheets("Sheet1").Range("f" &
intRow).Text)
strPhNum =
Trim(ThisWorkbook.Sheets("Sheet1").Range("g" &
intRow).Text)
fileStream.WriteLine "BEGIN:VCARD"
fileStream.WriteLine "VERSION:4.0"
fileStream.WriteLine "FN:" & strFname
fileStream.WriteLine "EMAIL;TYPE=:" & strEname
fileStream.WriteLine "ORG:" & strComname
fileStream.WriteLine " TITLE:" & strJOPname
fileStream.WriteLine "TEL;TYPE=Work;TYPE=PREF:" &
strphname
fileStream.WriteLine "URL:" & stradename
fileStream.WriteLine "TEL;TYPE=CELL;TYPE=PREF:" & strPhNum
fileStream.WriteLine "END:VCARD"
intRow = intRow +
1
strName =
ThisWorkbook.Sheets("Sheet1").Range("A" & intRow).Text
Wend
fileStream.Close
If
fso.FileExists(filepath) Then
MsgBox "VCF
file created Successfully?"
End If
End Sub