VBA Exсel

[Екатерина Попкова]

Добрый день!
помогите,указывает на ошибку,объект не найден:

Set CurFolder = FolderList(Account.Name).Folders(FolderType)


Sub ProcessFolder(FolderType As String)
For Each Account In objOutlook.Session.SyncObjects
Set CurFolder = FolderList(Account.Name).Folders(FolderType)
Application.StatusBar = "Ó÷åòíàÿ çàïèñü " & Account & _
", ïàïêà " & CurFolder
For Each FolderItem In CurFolder.Items
If FolderItem.MessageClass = "IPM.Note" Then
Set CurMsg = FolderItem
With CurMsg
Selector = DateDiff("s", .ReceivedTime, DateEnd)
If (Selector > 0) And (Selector < Interval) Then
If FolderType = sInbox Then
ActiveCell = .SenderName
If .SentOnBehalfOfName <> .SenderName Then
ActiveCell = ActiveCell & "(" & _
.SentOnBehalfOfName & ")"
End If
Else
ActiveCell = .To
If .CC <> "" Then ActiveCell = ActiveCell & _
", êîïèÿ:" & .CC
If .BCC <> "" Then ActiveCell = ActiveCell & _
", ñêðûòàÿ êîïèÿ:" & .BCC
End If
ActiveCell.Font.Size = 10 - Len(ActiveCell) \ _
iGoodAttachWidth
ActiveCell.WrapText = True
If Len(ActiveCell) > 50 Then _
ActiveCell.VerticalAlignment = xlTop
GoNext (sCol)
ActiveCell = .Size: GoNext (sCol)
If .Attachments.Count > 0 Then
For Each Attach In .Attachments
ActiveCell = ActiveCell & Attach.Filename & " "
Next Attach
ActiveCell = Left(ActiveCell, Len(ActiveCell) - 1)
ActiveCell.WrapText = True
ActiveCell.Font.Size = "6"
Else
ActiveCell = "íåò"
End If
If Len(ActiveCell) > MaxAttachmentsLen Then
MaxAttachmentsLen = Len(ActiveCell)
End If
GoNext (sCol)
ActiveCell = .ReceivedTime
ActiveCell.NumberFormat = "dd/mm/yyyy hh:mm"
GoNext (sCol)
ActiveCell = .Subject: GoNext (sCol)
ActiveCell = Account.Name: GoNext (sRow)
GoNext (sHome)
End If
End With '*** CurMsg
End If
Next FolderItem
Next Account
If FolderType = sInbox Then
GoNext (sHome): GoNext (sRow)
End If


End Sub
Sub Synchronization()
Dim Responce As Integer
Responce = MsgBox("Âûïîëíÿòü ñèíõðîíèçàöèþ?", _
vbYesNo, "Ìàêðîñ çàïóùåí")
If Responce = vbYes Then
For Each Account In objOutlook.Session.SyncObjects
Application.StatusBar = "Ó÷åòíàÿ çàïèñü: " & Account

CurSync.Init (Account)
CurSync.Start
Next Account
End If
End Sub
Sub CalculateInputRange()
OutputDataRange = ActiveCell.Address
If OutputDataRange <> "$" & sFirstCol & "$4" Then
LastInputRow = LTrim(Str(Val(Mid(OutputDataRange, 4, _
Len(OutputDataRange) - 3)) - 2))
InputDataRange = "$" & sFirstCol & "$3:$" & sLastCol & _
"$" & LastInputRow
Else
'*** Íåò íè îäíîãî âõîäÿùåãî ñîîáùåíèÿ
LastInputRow = "3"
GoNext (misc.sStart): GoNext (sRow): GoNext (sRow)
ActiveCell = "Çà óêàçàííûé ïåðèîä ñîîáùåíèé íå áûëî"
InputDataRange = ActiveCell.Address & ":"
GoNext (sRow)
GoNext (sRow)
End If
End Sub
Sub CalculateOutputRange()
OutputDataRange = ActiveCell.Address
LastInputRow = "$" & sFirstCol & "$" & _
LTrim(Str(Val(LastInputRow) + 4))
If OutputDataRange <> LastInputRow Then
OutputDataRange = LastInputRow & ":$" & sLastCol & "$" & _
LTrim(Str(Val(Mid(OutputDataRange, 4, _
Len(OutputDataRange) - 3)) - 1))
Else
'*** Íåò íè îäíîãî èñõîäÿùåãî ñîîáùåíèÿ
OutputDataRange = ActiveCell.Address & ":"
ActiveCell = "Çà óêàçàííûé ïåðèîä ñîîáùåíèé íå áûëî"
End If
End Sub
Sub Initialization()
Set objOutlook = New Outlook.Application
Set CurNameSpace = objOutlook.GetNamespace("MAPI")
Set FolderList = CurNameSpace.Folders
Application.StatusBar = ""
MaxAttachmentsLen = 0
End Sub
Sub Deinitialization()
objOutlook.Quit
Set objOutlook = Nothing
End Sub

[27102014]

Екатерина, у Вас в коде нет подключения к Outlook, что-то вроде такого

Set myFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

Также не совсем понятно что именно Вы пытаетесь сделать - проверить почту всех пользователей?
Возможно, имеет значение какая у Вас версия офиса.
И укажите, пжл, ссылку где брали макрос

[Екатерина Попкова]

Все равно возникает ошибка((Бибилиотека на оутлук и эксель подключена
А может вместо этой строчки прописать полный путь к папке в оутлуке.Как написать правильно?
P.S.это программка должна сформировать отчет о входящих писем оутлука в экселе.Ссылки нету,только вложенный файл с этой программкой

[27102014]

Ну какое у Вас подключение есть, если выходит ошибка?????
Правильно вот так

Set CurFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

это вместо строки с ошибкой

Set CurFolder = FolderList(Account.Name).Folders(FolderType)

Проверил у себя - все работает, только у меня выводится список не только полученных, но и отправленных сообщений - здесь сами разберетесь

Чтобы облегчить Вам жизнь файл прилагаю

[Екатерина Попкова]

Спасибо огромное!все пошло)))