Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Outlook , CDO, HTML stripper
Message
 
À
Tous
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Titre:
Outlook , CDO, HTML stripper
Divers
Thread ID:
00798120
Message ID:
00798120
Vues:
53
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
Fil
Voir

Click here to load this message in the networking platform