• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 718
  • Last Modified:

"Unspecified Error" saving changes to CDO.Message item

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
      While Not Rs.EOF
            if err.number <> 0 then
            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)
                        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
            If attname <> "Paperclip" AND attext <> "ico" Then
                  If Err.Number = 0 Then
                        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)
                                    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>"
                        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
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?
  • 5
  • 3
1 Solution
Try folder and iis permissions.
WilbatAuthor Commented:
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.
an this folder?
svcdir = "C:\temp\~Test Client"

in windows?
also that ~ looks weird
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

WilbatAuthor Commented:
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.
try changing msgobj.DataSource.Save    for    msgobj.DataSource.Close
if not im empty of thoughts or ideas
Anyway error 80004005 means "Unable to access"
WilbatAuthor Commented:
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.
Thank you for the points!

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now