Solved

"Unspecified Error" saving changes to CDO.Message item

Posted on 2007-03-26
8
704 Views
Last Modified: 2008-01-09
I have adapted the code below from a sample given by Glen Scales at OutlookExchange.com.  I had several errors using his code verbatim and slowly whittled it down to this.  However, I am still getting an error on the line msgobj.DataSource.Save.
The gist of the code is to check each message in the given Public Folder for attachments, save the attachments to a file system folder, remove the attachment from the message, add a small ICO file attachment back to the message and then to embed a link to the original file attachment in the message body.

Dim Rec,Rs,strURLInbox,msgobj,msgobj1,flds,objArgs,strView
cfpath = "file://./backofficestorage/domain.COM/PUBLIC FOLDERS/Cases/~Test Client" & cfpath
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set Conn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open cfpath
strView = "SELECT ""DAV:href"""
strView = strView & " FROM scope ('shallow traversal of """& cfpath & """') "
strview = strview & " WHERE ""DAV:isfolder"" = false and ""urn:schemas:httpmail:hasattachment"" = True and ""DAV:contentclass"" = 'urn:content-classes:message' "
rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
rs.CursorType = 3
Rs.Open strView, Conn, 2
If Rs.RecordCount <> 0 Then
      Rs.MoveFirst
      While Not Rs.EOF
            if err.number <> 0 then
                  rs.movenext
                  err.clear
            end if
            svcdir = "C:\temp\~Test Client"
            savepath = svcdir & "\"
            if not fso.folderexists(svcdir) then
                  set fldr = fso.createfolder(svcdir)
            end if
            Set msgobj = CreateObject("CDO.Message")
            msgobj.DataSource.Open rs.fields("DAV:href").value, ,3
            attachcount = msgobj.attachments.count
            Redim attarray(attachcount)
            Redim attnarray(attachcount)
            arrcnt = 1
            For Each objAttachment In msgobj.Attachments
                  If Instr(objAttachment.FileName, ".") > 0 Then
                        attname = Left(objAttachment.FileName, InStrRev(objAttachment.FileName,".") - 1)
                        attext = Mid(objAttachment.FileName, InStrRev(objAttachment.FileName,".") + 1)
                  Else
                        attname = objAttachment.FileName
                        attext = ""
                  End If                              
                  rtime = Replace(msgobj.ReceivedTime,"/","-")
                  rtime = Replace(rtime,":","-")
                  savefile = savepath
                  savefile = savefile & attname & " (" & rtime & ")." & attext
                  If attname <> "Paperclip" AND attext <> "ico" Then
                        On Error Resume Next
                        objAttachment.SaveToFile savefile
                        On Error Goto 0
                        attarray(arrcnt) = savefile
                        attnarray(arrcnt) = objAttachment.FileName
                        arrcnt = arrcnt + 1
                  End If
            Next
            If attname <> "Paperclip" AND attext <> "ico" Then
                  If Err.Number = 0 Then
                        msgobj.Attachments.DeleteAll
                        msgobj.AddAttachment "C:\Program Files\Exchsrvr\BIN\Paperclip.ico"
                        If msgobj.HTMLBody <> "" Then
                              If Instr(1, msgobj.HTMLBody, "</BODY") > 0 Then
                                    sHTMLBody = Left(msgobj.HTMLBody, Instr(1, msgobj.HTMLBody, "</BODY>") - 1)
                              Else
                                    sHTMLBody = msgobj.HTMLBody
                              End if
                        End If
                        For I = 1 to attachcount
                              msgobj.TextBody = msgobj.TextBody & vbCRLF & "****** Attachment: " & attnarray(i) & " <file://" & attarray(i) & ">"
                              sHTMLBody = sHTMLBody & vbCRLF & "<BR><B><DIV><FONT face=Arial color=#004000 size=2>****** Attachment: <A href=" & chr(34) & " file://" & attarray(i) & chr(34) & "> " & attnarray(i) & "</A></DIV>"
                        Next
                        If msgobj.HTMLBody <> "" Then
                              msgobj.HTMLBody = sHTMLBody & "<BR><BR></BODY></HTML>"
                        End If
                        msgobj.TextBody = msgobj.TextBody & vbCRLF & vbCRLF
                        msgbox msgobj.datasource.isdirty
                        msgobj.DataSource.Save    'error occurs here
                  End If
            End If
            Set msgobj = Nothing
            rs.MoveNext
      Wend
End If
Set rs = Nothing
Set conn = Nothing
Msgbox "done"

The error I get is:
Error: Unspecified Error
Code: 80004005
Source: CDO.Message.1

Ive tried just removing the attachment and saving, just adding an attachment as saving and just altering the text of the message body and saving.  I still get the same error each time (a hearty THANK YOU to MS for such descriptive error message btw).  Also, another strange thing is that when I check the IsDirty property of DataSource it says False?  Any thoughts or ideas?
0
Comment
Question by:Wilbat
  • 5
  • 3
8 Comments
 
LVL 2

Expert Comment

by:bandolex2
Comment Utility
Try folder and iis permissions.
0
 

Author Comment

by:Wilbat
Comment Utility
I checked the folder permissions through Outlook and the user account Im runninghte script as has Owner permissions.  I also checked the Administrative Rights in Exchange and it has full rights there as well.  IIS is setup for Integrated Windows authentication only so the permissions under the Exchange Administrative Rights should dictate to IIS unless Im mistaken.
So it doens't appear to be a permissions issue.
0
 
LVL 2

Expert Comment

by:bandolex2
Comment Utility
an this folder?
svcdir = "C:\temp\~Test Client"

in windows?
also that ~ looks weird
0
 

Author Comment

by:Wilbat
Comment Utility
That is the folder the script creates to save the attachments in.  It has no problem creating the folder or saving the attachments in it.  That part works fine.  It's just when I try saving the changes Ive made to the CDO.Message object.
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 2

Expert Comment

by:bandolex2
Comment Utility
try changing msgobj.DataSource.Save    for    msgobj.DataSource.Close
if not im empty of thoughts or ideas
0
 
LVL 2

Accepted Solution

by:
bandolex2 earned 500 total points
Comment Utility
Anyway error 80004005 means "Unable to access"
0
 

Author Comment

by:Wilbat
Comment Utility
Update:  When I was getting the error I was logged into the Exchange Server as administrator and just double clicking on the .VBS file.
Just as a swing in the dark I setup the script to run via a Scheduled Task using Administrator for the credentials and it worked.  Not sure why but it obviously did have something to do with permissions so Im gonna give you the points for pointing me in the right direction.
Thanks!
0
 
LVL 2

Expert Comment

by:bandolex2
Comment Utility
Thank you for the points!
band.
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
Disabling the Directory Sync Service Account in Office 365 will stop directory synchronization from working.
In this video we show how to create an Accepted Domain in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Ac…
how to add IIS SMTP to handle application/Scanner relays into office 365.

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now