1

Тема: VBA: Outlook создание папки и добавление в неё контактов

всем привет, нужна помощь, есть проблема на работе нужно чтобы в Outlook видели дату рождения сотрудников, есть список в xls формате, нашел скрипт который добавляет из xls в Outlook людей, но нужно чтобы создавал отдельную папку для такого списка, и перед каждым добавление обнулял этот список
1) очищение папки
2) создание отдельной папки - сотрудники
3) добавление записей из xls сотрудников

1) скрипт удаление всех записей из Outlook подскажите как задать, чтобы удалял именно из папки контакты?


 Dim myOutlook
 Dim myInformation
 Dim myContacts
 Dim i
 Dim lngCount
 Set myOutlook = CreateObject("Outlook.Application")
 Set myInformation = myOutlook.GetNamespace("MAPI")
 Set myContacts = myInformation.GetDefaultFolder(10).Items
 lngCount = myContacts.Count
 For i = lngCount To 1 Step -1
 myContacts(i).Delete
 Next
 Set myInformation = Nothing
 Set myOutlook = Nothing
 Set myContacts = Nothing

2 скрипт добавляет сотрудников из списка xls, как тут задать чтобы добавлял в отдельную папку сотрудники


 Dim objXls
 Dim i, j 
 Dim myNameSpace 
 Dim myFolder, myWorkFolder
 Dim myOutlook
 Dim myItems
 Set objXls = CreateObject("Excel.Application")
 objXls.Workbooks.Open "C:\Data.xls"
 'укажите путь и имя существующего файла
 objXls.Application.Visible = False
 Set myOutlook = CreateObject("Outlook.Application")
 j = objXls.ActiveSheet.UsedRange.Rows.Count
    For i = 1 To j
    Set myItems = myOutlook.CreateItem(2)
        With myItems
    .FullName = objXls.ActiveSheet.Range("A" & i).Value & " " & _
                objXls.ActiveSheet.Range("B" & i).Value & " " & _
                objXls.ActiveSheet.Range("C" & i).Value
    .Birthday = objXls.ActiveSheet.Range("D" & i).Value
    .Email1Address = objXls.ActiveSheet.Range("E" & i).Value
    .Save
 End With
    Next
objXls.quit
Set objXls = Nothing
Set myOutlook = Nothing