Тема: 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