Solved

"Unspecified Error" saving changes to CDO.Message item

Posted on 2007-03-26
8
709 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 2

Expert Comment

by:bandolex2
ID: 18795528
Try folder and iis permissions.
0
 

Author Comment

by:Wilbat
ID: 18795584
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
ID: 18795617
an this folder?
svcdir = "C:\temp\~Test Client"

in windows?
also that ~ looks weird
0
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 

Author Comment

by:Wilbat
ID: 18795662
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
 
LVL 2

Expert Comment

by:bandolex2
ID: 18795763
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
ID: 18795776
Anyway error 80004005 means "Unable to access"
0
 

Author Comment

by:Wilbat
ID: 18796098
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
ID: 18796243
Thank you for the points!
band.
0

Featured Post

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Exchange Server 2007 to 2013 Migration 13 62
Migrating from Exchange 2010 to 2013 2 72
NLB +DAG 8 54
Exchange 2010 to Exchange 2016 - VERY slow Mailbox Move 4 111
This article explains in simple steps how to renew expiring Exchange Server Internal Transport Certificate.
After hours on line I found a solution which pointed to the inherited Active Directory permissions . You have to give/allow permissions to the "Exchange trusted subsystem" for the user in the Active Directory...
In this video we show how to create a Contact 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 Recipients >> Contact ta…
In this video we show how to create a mailbox database 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 Servers >> Data…

751 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