شكل البطاقة بالحقول حطيت الارقام في خانة company and job title لان اذا اضيفت في خانة ارقام الهواتف لا تظهر في برنامج Outlook للموبايل ( تحايل )
 
	-----------
 
	** حصلت هذا الكود شغال لاضافة جميع جهات الاتصال او البطاقات الى برنامج outlook
 
	 
 
	Sub OpenSaveVCard() 
	     
	Dim objWSHShell As IWshRuntimeLibrary.IWshShell 
	Dim objOL As Outlook.Application 
	Dim colInsp As Outlook.Inspectors 
	Dim strVCName As String 
	Dim fso As Scripting.FileSystemObject 
	Dim fsDir As Scripting.Folder 
	Dim fsFile As Scripting.File 
	Dim vCounter As Integer 
	    
	Set fso = New Scripting.FileSystemObject 
	Set fsDir = fso.GetFolder("C:\vcards")
 
	For Each fsFile In fsDir.Files
 
	'original code 
	'strVCName = "C:\vcards\" & fsFile.Name
 
	'Zeda's fix for spaces in filenames 
	strVCName = """C:\vcards\" & fsFile.Name & """"
 
	    Set objOL = CreateObject("Outlook.Application") 
	    Set colInsp = objOL.Inspectors 
	        If colInsp.Count = 0 Then 
	        Set objWSHShell = CreateObject("WScript.Shell") 
	        objWSHShell.Run strVCName 
	        Set colInsp = objOL.Inspectors 
	    If Err = 0 Then 
	            Do Until colInsp.Count = 1 
	                DoEvents 
	            Loop 
	            colInsp.Item(1).CurrentItem.Save 
	            colInsp.Item(1).Close olDiscard 
	            Set colInsp = Nothing 
	            Set objOL = Nothing 
	            Set objWSHShell = Nothing 
	        End If 
	    End If
 
	Next
 
	End Sub 
	 
 
	 
 
	 
 
st.rar