Information générale
Catégorie:
Codage, syntaxe et commandes
Titre:
Outlook , CDO, HTML stripper
Hi, I am trying to use a snippet of code that can strip away HTML from a message
in Outlook. I have made some headway but am having trouble translating the CDO
code. Can anyone help with this?
these lines seem to work and I indicate where I am stuck below
as *111111*******
loOutlook = CREATEOBJECT('Outlook.Application')
loNS = loOutlook.GetNameSpace('MAPI')
loInbox = loNS.GetDefaultFolder(6)
FullCount = loInbox.Items.Count
x=Fullcount
do while x > 0
? x, Fullcount
loInboxItems = loInbox.Items
loEmail = loInboxItems.Item(x)
if len(alltrim(loEmail.Body))=0
do StripHtml
endif
x = x - 1
enddo
proc StripHtml && something like this??
sEntry = loEmail.EntryID
oCDO = CreateObject("MAPI.Session")
oCDOMs = Createobject("CDO.Message")
*but this one does not yet it seems to be the key to working witht he html code
*111111****************************************** stuck here
oCDOMsg = oCDOMs.GetMessage(sEntry)
Here is the full code snippet, by Ken Slovak
Private Sub oInbox_ItemAdd(ByVal Item As Object)
Dim oCDO As MAPI.Session
Dim oCDOMsg As MAPI.Message
Dim oField As MAPI.Field
Dim sEntry As String
Dim sMsg As String
Const CdoPR_HTML_BODY = &H1013001E
Const CdoPR_HTMLPLAIN_BODY = &H7101001F
If TypeName(Item) = "MailItem" Then
On Error Resume Next
If Item.HTMLBody <> vbNullString Then
sMsg = Item.Body
Item.Body = sMsg
Item.Save
sEntry = Item.EntryID
Set Item = Nothing
Set oCDO = CreateObject("MAPI.Session")
oCDO.Logon "", "", False, False
Set oCDOMsg = objCDO.GetMessage(sEntry)
sMsg = oCDOMsg.Text
oCDOMsg.Fields(CdoPR_RTF_COMPRESSED).Delete
oCDOMsg.Fields(CdoPR_RTF_IN_SYNC).Delete
oCDOMsg.Fields(CdoPR_RTF_SYNC_BODY_COUNT).Delete
oCDOMsg.Fields(CdoPR_RTF_SYNC_BODY_CRC).Delete
oCDOMsg.Fields(CdoPR_RTF_SYNC_BODY_TAG).Delete
oCDOMsg.Fields(CdoPR_RTF_SYNC_PREFIX_COUNT).Delete
oCDOMsg.Fields(CdoPR_RTF_SYNC_TRAILING_COUNT).Delete
Set oField = oCDOMsg.Fields(CdoPR_HTML_BODY)
If Err = 0 Then
oCDOMsg.Fields(CdoPR_HTML_BODY).Delete
Else
Err.Clear
End If
Set oField = oCDOMsg.Fields(CdoPR_HTMLPLAIN_BODY)
If Err = 0 Then
oCDOMsg.Fields(CdoPR_HTMLPLAIN_BODY).Delete
Else
Err.Clear
End If
oCDOMsg.Text = strMsg
oCDOMsg.Update
objCDO.Logoff
End If
End If
Set oField = Nothing
Set oCDO = Nothing
Set oCDOMsg = Nothing
End Sub
endproc
Suivant
Répondre
Voir le fil de ce thread
Voir le fil de ce thread à partir de ce message seulement
Voir tous les messages de ce thread
Voir tous les messages de ce thread à partir de ce message seulement