добРЫЙ день всем форумчанам.. помогите если есть такое решение ...
необходимо производить вставку данных из тела письма из oulook 2003 в excel 2003 средствами VBA непосредственно из самого excel-я , отбор вставляемых данных проводится по критериям темы письма и адрема отправителя..

Заранее спасибо!!!

The page must be viewed over a secure channel/// ((

ну все что я смог звлечь из приложенного файла так это получить доступ к папке .. с сообщениями , хотя и в этом не уверен.. а вот как обработать ? нашел кое что в инете :
Public Sub SavePismo()
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolders = myNameSpace.GetDefaultFolder(olFolderInbox)
Set mailItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
For Each it In mailItems
If it.UnRead Then Set direct = CreateObject("Scripting.FileSystemObject")
If it.SenderName = "" Then it.SenderName = "un_name"
md = "C:\Temp\"
mdd = "C:\Temp\" & Str(Date) & "\"
mddM = "C:\Temp\" & Str(Date) & "\" & it.SenderName & "\"
If Not direct.folderexists(md) Then MkDir (md)
If Not direct.folderexists(mdd) Then MkDir (mdd)
If Not direct.folderexists(mddM) Then MkDir (mddM)
fileforsave = it.SenderName & ".txt"
it.SaveAs mddM & "\" & fileforsave, olTXT
Next
End Sub
однако ругается на строку "If Not direct.folderexists(md) Then" Object required !!

помогите ... народ...

2Taranaga

сваял кое что:
Dim ns As Outlook.NameSpace
Dim mi As Outlook.MailItem
Dim fl As Outlook.MAPIFolder
Set ns = GetNamespace("MAPI")
Set fl = ns.Folders("serg").Folders("Входящие")
Set mi = fl.Items(fl.Items.Count)
Set direct = CreateObject("Scripting.FileSystemObject")
FileName = "C:\" & mi.Subject & ".txt"
Set file = direct.CreateTextFile(FileName, True)
file.Write mi.Body
но как сделать перебор сообщений ? и вставку Body в книгу excel ? подскажите ?

Sub maketov()

Ну вот после многоих дней мучений пришлось таки сесть и покопаться в лабиринтах VBA OUTLOOK // и в итоге вот что получилось. ))) Всем кто откликнулся огромное спасибо !!!
Dim ns As Outlook.NameSpace
Dim mi As Outlook.MailItem
Dim fl As Outlook.MAPIFolder


Set ns = GetNamespace("MAPI")
ns.Logon

Set fl = ns.Folders("diop").Folders("Входящие").Folders("макеты")

If fl.Items.Count > 0 Then
For i = 1 To fl.Items.Count
Set direct = CreateObject("Scripting.FileSystemObject")
FileName = "C:\Temp\" & fl.Items(i).Subject & ".xls"
Set File = direct.CreateTextFile(FileName, True)
File.Write fl.Items(i).Body
Next i
End If
End Sub