Помогите пожалуйста со скриптом VB, который
1. перебирает почтовые сообщения (по Subject, имени Excel документа в скрепке)
2. найдя нужные параметры читает данные из оперделенной ячейки Excel документа (который в скрепке)
3. складывает эти данные в другой документ Excel

net_Alex_tut,

Разобрался
Написал скрипт
Все работает :
Ищутся непрочтенные письма по теме и типу приложения выбираются аттач и читаются данные
после прочтения данных сообщение помечается как прочитанное

два но:
1) при небольшом количестве непрочтенных сообщений - 6-15 при общем колве в инбох около 300-400 работает норм
если же количество непрочтенных 30-60 начинаются глюки- перескакивает через пачку сообщений в результате куски сообщений нерочтенные
приходится по нескольку раз запускать чтобы все сообщения перебрались
в чем тут дело ?
2) для чтения из эксель файла - аттачмента его нужно открыть что занимет время особенно если док эксель большой
можно ли без открытия эксель файла из него читать данные ?

Const olFolderInbox As Integer = 6

'~~> Path for the attachment

Const AttachmentPath As String = "e:\temp\"

Sub DORscan_1()

    Dim oOlAp As Object, oOlns As Object, oOlInb As Object

    Dim oOlItm As Object, oOlAtch As Object

    Dim wb As Workbook

    Dim i As Integer

    i = 1

    Dim value As Variant

    Dim value1 As Variant

    Dim value2 As Variant

    Dim value3 As Variant

    Dim value4 As Variant

    Dim value5 As Variant

    Dim v_date As String

    '~~> New File Name for the attachment

    Dim NewFileName As String

    NewFileName = AttachmentPath & "test1.xls"

    '~~> Get Outlook instance

    Set oOlAp = GetObject(, "Outlook.application")

    Set oOlns = oOlAp.GetNamespace("MAPI")

    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails

    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then

        MsgBox "NO Unread Email In Inbox"

        Exit Sub

    End If

    '~~> Extract the attachment from the 1st unread email

    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")

        '~~> Check if the email actually has an attachment

        sSubj = oOlItm.Subject

        If Left(sSubj, 9) = "WD/CD DOR" Then

            If oOlItm.Attachments.Count <> 0 Then

                For Each oOlAtch In oOlItm.Attachments

                        If Left(Right(oOlAtch.Filename, 5), 4) = ".xls" And Left(oOlAtch.Filename, 2) = "WD" Then

                            '~~> Download the attachment

                            oOlAtch.SaveAsFile NewFileName

                            Set wb = Workbooks.Open(NewFileName, UpdateLinks:=0)

                            i = i + 1

                            Sheets("WDDP-A Daily Highlight").Select

                            v_date = Range("L4")

                            value = Range("E33")

                            value1 = Range("E34")

                            Windows("WD DOR.xlsm").Activate

                            Sheets("list1").Select

                            Cells(i, 1).value = v_date

                            Cells(i, 2).value = value

                            Cells(i, 3).value = value1

                            If i = 30 Or i = 100 Or i = 200 Or i = 300 Or i = 400 Then

                                ActiveWorkbook.Save

                            Else

                            End If

                            Application.DisplayAlerts = False

                            Workbooks("test1.xls").Close SaveChanges:=False

                            Else

                           ' MsgBox "attachment is not excel"

                        End If

                        'Exit For

                 Next

            Else

                'MsgBox "The First item doesn't have an attachment"

            End If

        Else

        End If

        oOlItm.UnRead = False

        'DoEvents

        'oOlItm.Save

    Next

 End Sub