powershelloutlookvcf-vcard

How to import multiple vCard VCF contact files into Outlook using Powershell?


How can I import multiple vCard VCF contact files into Outlook using Powershell ?

My script for create vcf is :

    # Création d'un fichier.vcf

New-Item C:\TEST\$($LastName)_$($Name).vcf -type file -force -value "
BEGIN:VCARD
VERSION:2.1
N;LANGUAGE=fr;CHARSET=utf-8:$($Agence) 
FN;CHARSET=utf-8:$($LastName), $($Name)
ORG;CHARSET=utf-8:$($Company)
TITLE;CHARSET=utf-8:$($Title)
TEL;WORK;VOICE:$($WorkNum)
TEL;WORK;VOICE:$($WorkNum2)
TEL;CELL;VOICE:$($MobNum)
LABEL;WORK;PREF;CHARSET=utf-8;ENCODING=QUOTED-PRINTABLE:$($WorkAdress)
X-MS-OL-DEFAULT-POSTAL-ADDRESS:1
EMAIL;CHARSET=utf-8;PREF;INTERNET:$($Email)
X-MS-IMADDRESS;CHARSET=utf-8:$($Email) 
PHOTO;TYPE=JPEG;ENCODING=BASE64:$($encodedImage)

X-MS-OL-DESIGN;CHARSET=utf-8:<card xmlns='http://schemas.microsoft.com/office/outlook/12/electronicbusinesscards' ver='1.0' layout='left' bgcolor='ffffff'><img xmlns='' align='fit' area='16' use='cardpicture'/><fld xmlns='' prop='name' align='left' dir='ltr' style='b' color='000000' size='10'/><fld xmlns='' prop='org' align='left' dir='ltr' color='000000' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns=' prop='telwork' align='left' dir='ltr' color='d48d2a' size='8'><label align='right' color='626262'>Bureau</label></fld><fld xmlns='' prop='telhome' align='left' dir='ltr' color='d48d2a' size='8'><label align='right' color='626262'>Domicile</label></fld><fld xmlns='' prop='email' align='left' dir='ltr' color='d48d2a' size='8'/><fld xmlns='' prop='addrwork' align='left' dir='ltr' color='000000' size='8'/><fld xmlns='' prop='im' align='left' dir='ltr' color='000000' size='8'><label align='right' color='626262'>Mess. instant.</label></fld><fld xmlns='' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns=' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/><fld xmlns='' prop='blank' size='8'/></card>
END:VCARD"`

Solution

  • I haven't found answers at my question, so I used an other technical.

    First, I created a Csv and I converted it to XLs with this Powershell code :

        # Creating and Adding the first line of the Csv
      $String = "FullName;CompanyName;Email1Address;Fileas;JobTitle;BusinessTelephoneNumber;Business2TelephoneNumber;MobileTelephoneNumber;BusinessAdress;PathImage"
    
      $PathCsv = "C:\TEST\Contacts.csv"
      $CsvExists = Test-Path $PathCsv 
    
     if($CsvExists -eq $True) {
         Clear-Content $PathCsv 
         Add-Content $PathCsv -value $String
     } else {
         New-Item $PathCsv -type file  -value $String   
     }
    
     For Each .... {
    
        # Storing Information in variables
      $Name = "..."
      $Last [...] 
    
        # Adding the information in the Csv
      $string2= "$($Name) $($LastName);$($Corp);$($Email);$($Agence);$($Title);$($NumWork);$($NumWork2);$($NumCell);$($WorkAdress);$($path)"
    
      Add-Content -path $PathCsv -value $string2
    
    
         # Converting Csv to Xls
      $PathXls = "C:\TEST\Contacts.xls"
      $XlsExists= Test-Path $PathXls
      $xl = new-object -comobject excel.application
      $xl.visible = $true
      $Workbook = $xl.workbooks.open($PathCsv) 
      $Worksheets = $Workbooks.worksheets
    
     if($XlsExists -eq $True) {
       Remove-Item $PathXls -force
     }  
      $Workbook.SaveAs($PathXls,1) 
      $Workbook.Saved = $True
    
     $xl.Quit()
     }
    

    Second, I created Outlook contact with this VBScript :

      Sub creater()
    
          Dim strPath
          Dim num1 
          Dim num1toreplace 
          Dim num2 
          Dim num2toreplace 
          Dim num3 
          Dim num3toreplace 
          Dim Corp 
    
            Const olContactItem = 2
    
          Set objOutlook = CreateObject("Outlook.Application")
          Set objExcel = CreateObject("Excel.Application")
          Set objWorkbook = objExcel.Workbooks.Open("C:\TEST\Contacts.xls")
    
    
           x = 2
    
        Do Until objExcel.Cells(x, 1).Value = ""
    
          Set objContact = objOutlook.CreateItem(olContactItem)
    
          'Add FullName
           objContact.FullName = objExcel.Cells(x, 1).Value
    
          'Add CompanyName
           objContact.CompanyName = objExcel.Cells(x, 2).Value
    
          'Add Email1Address
           objContact.Email1Address = objExcel.Cells(x, 3).Value
    
          'Add Fileas
           objContact.Fileas = objExcel.Cells(x, 4).Value
    
          'Add JobTitle
           objContact.JobTitle = objExcel.Cells(x, 5).Value
    
          'Add BusinnesNum
           objContact.BusinessTelephoneNumber  = objExcel.Cells(x, 6).Value
    
          'Add BusinnesNum2
           objContact.Business2TelephoneNumber = objExcel.Cells(x, 7).Value
    
          'Add MobileNum
           objContact.MobileTelephoneNumber = objExcel.Cells(x, 8).Value
    
          'Add BusinessAddress
           objContact.BusinessAddress = objExcel.Cells(x, 9).Value
    
          'Add Picture
           strPath = objExcel.Cells(x, 10).Value
          If Not strPath = vbNullString Then
             objContact.AddPicture (strPath)
          End If
    
    
          objContact.Save
    
          x = x + 1
        Loop
    
          objExcel.Quit
    
     End Sub 
     creater()