- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
- 84
- 85
- 86
- 87
- 88
- 89
- 90
- 91
Function ShowAddressBook() As String
On Error GoTo ErrorHandler
Dim miTempItem As MailItem
Dim inTempInspector As Inspector
Dim Pomoechka As MAPIFolder
Dim objNS As outlook.NameSpace
' Загружаем шаблон формы онового сообщения
' на нём есть нужная кнопка
Dim Reg As New CReg
10 Reg.m_MainKey = "Software\Content Manager\MS_OUTLOOK"
20 Set miTempItem = Application.CreateItemFromTemplate(Reg.GetValue("path") & "\crutch.oft")
30 Set inTempInspector = miTempItem.GetInspector
32 miTempItem.UserProperties.Add("TempItemForAddressBook", olYesNo) = True
' Убираем инспектор с глаз долой
40 inTempInspector.Left = -20000
50 inTempInspector.Top = -20000
'51 inTempInspector.Width = 0
'52 inTempInspector.Height = 0
' пока инспектор не покажеться адресбук из него не выдавишь
60 inTempInspector.Activate
' если до вызова адресбука пользователь работал
' с развёрнутым на весь экран письмом - то хрен мы его куда свинем
' нужно, поэтому, вернуть нормальное состояние
70 inTempInspector.WindowState = olNormalWindow
' правда, это в некоторых случаях моргает - но поставить olonormalWindow
' до того как инспектор показан - нельзя.
' рахзвёрнутость ил не развёрнутость задаёться в реестре по пути
' HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Message\Frame
' там храниться REG_BINARY и внём меняетсья 0xB байт либо на 3 либо на 1
' подгрузили всё что надо - вызываем саму книгу
'НОВАЯ ВЕРСИЯ
80 inTempInspector.CommandBars.FindControl(Id:=353).Execute
Dim strBuff As String
' Пока не сделаю сейв, поле TO через мапи будет не доступным
90 miTempItem.save
' получаю поле ТО через MAPI
' если попытаться взять его на прямую - то аутлук будет ругатся
' своим ёбанным диалогом безопасности
100 strBuff = GetToField(miTempItem)
' закрываем итемку
110 miTempItem.Close olDiscard
' Теперь, из-за того что вызывали метод save итемка лежит в папке
' с черновиами, нахер она там не сдалась - нужно удалять
' если её просто удалить .delete то она передвиниться в папку
' с удалёнными письмами - тоже нафик не надо
' поэтому, сначала переносим её в эту папку самостоятельно
' и от туда вызываем .delete - письмо исчезает
' Получаем доступ к папке с удалёнными письмами
120 Set objNS = Application.GetNamespace("MAPI")
' вот тут она лежит
130 Set Pomoechka = objNS.GetDefaultFolder(olFolderDeletedItems)
' перемещаем туда письмецо
140 miTempItem.Move Pomoechka ' хотя можно и просто miTempItem.Delete
' теперь берём последнее письмо из помойки - это наше
' и удаляем его от туда
150 Pomoechka.Items(Pomoechka.Items.Count).Delete
' Теперь письма нету
ShowAddressBook = strBuff
KillObjects:
' Всё подчистим
160 Set miTempItem = Nothing
170 Set inTempInspector = Nothing
180 Set Pomoechka = Nothing
190 Set objNS = Nothing
200 Set Reg = Nothing
Exit Function
ErrorHandler:
subGlobalErrorHandler Err.Description, Err.number, Erl, "ShowAddressBook"
Resume KillObjects
End Function
guest 09.04.2009 10:33 # +1
guest 24.04.2009 09:03 # +1
Аккуратный проход по полю граблей аутлука...
guest 19.08.2009 14:40 # 0
guest 10.09.2009 21:27 # 0
Set miTempItem = Application.CreateItemFromTemplate(Reg.G etValue("path") & "\crutch.oft")
Crutch это костыль по-английски... :)