VBATools

Export kontaktów jako wizytówki VCard

by on Jul.03, 2010, under Outlook, Porady

Poniższe makro pozwala na export kontaktów w formacie wizytówek ze wskazanego folderu Outlooka.Docelowym folderem jest katalog “C:\Kontakty”.

Option Explicit
Sub Export_PAB_to_vcfs()
'MVP OShon from VBATools.pl
 Dim myOlApp As Outlook.Application
 Dim objContact As ContactItem
 Dim olNs As NameSpace
 Dim NumItems&, i&, strName$
 Dim myFolder As MAPIFolder

 Set myOlApp = New Outlook.Application
 Set olNs = myOlApp.GetNamespace("MAPI")

 Dim bExitFor: bExitFor = False
 Do
  Set myFolder = Application.GetNamespace("MAPI").PickFolder
  If myFolder Is Nothing Then Exit Sub
  If myFolder.DefaultMessageClass <> "IPM.Contact" Then
   MsgBox "Wpisanie inf do folderu ''" & myFolder.Name & "'' nie jest możliwe." & vbCr _
   & "Wybierz folder kontaktów!", vbExclamation, " Informacja o błędzie VBATools.pl"
   Set myFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
  Else
   bExitFor = True
  End If
 Loop While Not bExitFor

 Set myFolder = Application.GetNamespace("MAPI").GetFolderFromID(myFolder.EntryID, myFolder.StoreID)
 NumItems = myFolder.Items.Count

On Error Resume Next
 MkDir "c:\kontakty"

 For i = 1 To NumItems
 DoEvents
 Set objContact = myFolder.Items(i)
 If Not TypeName(objContact) = "Nothing" Then
 If Not objContact.FullName = "" Then
 strName = "C:\kontakty" & objContact.FullName & ".vcf"

 objContact.SaveAs strName, olVCard
 End If
 End If
 Next

 Set myOlApp = Nothing
 Set olNs = Nothing
 Set myFolder = Nothing

 MsgBox "Gotowe"
 End Sub

Makro zmodyfikowane na potrzeby forumowicza Outlook pl.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Joanna Subik
Profile picture of Karol Stilger
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała