<?xml version="1.0" encoding="utf-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
	<channel>
		<title><![CDATA[Серый форум &mdash; VBA: Outlook создание папки и добавление в неё контактов]]></title>
		<link>http://forum.script-coding.com/viewtopic.php?id=9378</link>
		<atom:link href="http://forum.script-coding.com/extern.php?action=feed&amp;tid=9378&amp;type=rss" rel="self" type="application/rss+xml" />
		<description><![CDATA[Недавние сообщения в теме «VBA: Outlook создание папки и добавление в неё контактов».]]></description>
		<lastBuildDate>Mon, 17 Mar 2014 04:12:14 +0000</lastBuildDate>
		<generator>PunBB</generator>
		<item>
			<title><![CDATA[VBA: Outlook создание папки и добавление в неё контактов]]></title>
			<link>http://forum.script-coding.com/viewtopic.php?pid=80903#p80903</link>
			<description><![CDATA[<p>всем привет, нужна помощь, есть проблема на работе нужно чтобы в Outlook видели дату рождения сотрудников, есть список в xls формате, нашел скрипт который добавляет из xls в Outlook людей, но нужно чтобы создавал отдельную папку для такого списка, и перед каждым добавление обнулял этот список<br />1) очищение папки<br />2) создание отдельной папки - сотрудники<br />3) добавление записей из xls сотрудников</p><p>1) скрипт удаление всех записей из Outlook подскажите как задать, чтобы удалял именно из папки контакты?</p><div class="codebox"><pre><code>
 Dim myOutlook
 Dim myInformation
 Dim myContacts
 Dim i
 Dim lngCount
 Set myOutlook = CreateObject(&quot;Outlook.Application&quot;)
 Set myInformation = myOutlook.GetNamespace(&quot;MAPI&quot;)
 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
</code></pre></div><p>2 скрипт добавляет сотрудников из списка xls, как тут задать чтобы добавлял в отдельную папку сотрудники<br /></p><div class="codebox"><pre><code>
 Dim objXls
 Dim i, j 
 Dim myNameSpace 
 Dim myFolder, myWorkFolder
 Dim myOutlook
 Dim myItems
 Set objXls = CreateObject(&quot;Excel.Application&quot;)
 objXls.Workbooks.Open &quot;C:\Data.xls&quot;
 &#039;укажите путь и имя существующего файла
 objXls.Application.Visible = False
 Set myOutlook = CreateObject(&quot;Outlook.Application&quot;)
 j = objXls.ActiveSheet.UsedRange.Rows.Count
    For i = 1 To j
    Set myItems = myOutlook.CreateItem(2)
        With myItems
    .FullName = objXls.ActiveSheet.Range(&quot;A&quot; &amp; i).Value &amp; &quot; &quot; &amp; _
                objXls.ActiveSheet.Range(&quot;B&quot; &amp; i).Value &amp; &quot; &quot; &amp; _
                objXls.ActiveSheet.Range(&quot;C&quot; &amp; i).Value
    .Birthday = objXls.ActiveSheet.Range(&quot;D&quot; &amp; i).Value
    .Email1Address = objXls.ActiveSheet.Range(&quot;E&quot; &amp; i).Value
    .Save
 End With
    Next
objXls.quit
Set objXls = Nothing
Set myOutlook = Nothing
</code></pre></div>]]></description>
			<author><![CDATA[null@example.com (lazovskiyrf)]]></author>
			<pubDate>Mon, 17 Mar 2014 04:12:14 +0000</pubDate>
			<guid>http://forum.script-coding.com/viewtopic.php?pid=80903#p80903</guid>
		</item>
	</channel>
</rss>
