Collaboration Data Objects E_ACCESSDENIED Error

[jmrdaddy]

I’ve had a system crash. I was able to salvage much of my stuff, but had to reload applications. I used the piece of code at the end of the post in Outlook to collect addresses before the crash without problems. But now I get a run time error Collaboration Data Objects E_ACCESSDENIED(80070005). I’ve read that you’ll get this message if the user answers “No” to the “Do you want this program to access, blah, blah, blah…” prompt. However, this prompt does not appear before I get the error. Is this some sort of security setting in Outlook that I need to loosen up? I could use someone’s help. Thanks



Option Explicit

Sub GetSenderName()

Dim strAddress As String
Dim objSession As MAPI.Session
Dim objFolder As Folder
Dim objItem As MAPI.Message
Dim objAddress As MAPI.AddressEntry
Dim strShortAddress As String
Dim lngStart As Integer
Dim intCount As Integer
Dim i As Integer
Dim intFirstDotPos As Integer
Dim intLastDotPos As Integer
Dim strDate As String
Dim strTime As String
Dim strFileName As String
Dim intFileNum As String

Set objSession = CreateObject("MAPI.Session&quot

objSession.Logon , , , False

Set objFolder = objSession.GetDefaultFolder(1)

intCount = objFolder.Messages.Count

strDate = Format(Date, "mmddyy&quot

strTime = Format(Time, "hhmmss&quot

strFileName = "c:\my documents\email domains " + _
strDate + strTime + ".txt"

intFileNum = FreeFile()

Open strFileName For Output As intFileNum

For i = 1 To intCount

Set objItem = objFolder.Messages.Item(i)

If objItem.UnRead = True Then

Set objAddress = objItem.Sender

strAddress = objAddress.Address

lngStart = InStr(1, strAddress, "@", _
vbTextCompare) + 1

strShortAddress = Mid(strAddress, lngStart, 1000)

intFirstDotPos = InStr(1, strShortAddress, ".", _
vbTextCompare)

intLastDotPos = InStrRev(strShortAddress, ".", _
-1, vbTextCompare)

While intLastDotPos > intFirstDotPos

strShortAddress = Mid(strShortAddress, _
intFirstDotPos + 1, 1000)

intFirstDotPos = InStr(1, strShortAddress, _
".", vbTextCompare)

intLastDotPos = InStrRev(strShortAddress, _
".", -1, vbTextCompare)

Wend

Debug.Print strShortAddress

Print #intFileNum, strShortAddress

End If

Next

Close

objSession.Logoff

End Sub