> Tech > Listings

Listings

Tech - Par iTPro - Publié le 24 juin 2010
email

LISTING 1: La sous-routine ConvertHTMLToDefault

Sub ConvertHTMLToDefault(objMsg As MailItem)
  Select Case objMsg.BodyFormat
    Case olFormatHTML, olFormatUnspecified
      objMsg.BodyFormat = olFormatPlain
      objMsg.Save
    Case Else
      ‘ RTF or plain text are OK
  End Select
  Set objMsg = Nothing
End Sub

LISTING 2: La sous-routine ConvertHTMLToDefaultWithAtts
Sub ConvertHTMLToDefaultWithAtts(objMsg As MailItem)
  Dim intAtts

Listings

As Integer
Dim strFileName As String
Dim strAttPath As String
Dim objAtt As Attachment
Dim strAttList As String
Dim i As Integer
‘ #### USER OPTION ####
‘ folder where you want to store attachments from HTML messages
strAttPath = « C:\temp\ »
If Right(strAttPath, 1) <> « \ » Then
strAttPath = strAttPath & « \ »
End If
Select Case objMsg.BodyFormat
Case olFormatHTML, olFormatUnspecified
intAtts = objMsg.Attachments.Count
For i = intAtts To 1 Step -1
Set objAtt = objMsg.Attachments.Item(i)
strFileName = objAtt.FileName
If InStr(objMsg.HTMLBody, « cid: » & strFileName) > 0
Then
strFileName = objMsg.Subject &  » –  » & strFileName
strFileName = ValidFileName(strFileName)
strFileName = strAttPath & strFileName
objAtt.SaveAsFile strFileName
objAtt.Delete
If strAttList = «  » Then
strAttList = vbCrLf & vbCrLf & _
« * EMBEDDED ATTACHMENTS * » & vbCrLf & vbCrLf
End If
strAttList = strAttList &  »  » & vbCrLf
End If
Next
objMsg.BodyFormat = olFormatPlain
objMsg.Body = objMsg.Body & strAttList
objMsg.Save
Case Else
‘ RTF or plain text are OK
End Select
Set objAtt = Nothing
Set objMsg = Nothing
End Sub

Function ValidFileName(strText As String)
‘ removes invalid characters and sets length to max 215
Dim strBadChars As String
Dim i As Integer
Dim intPos As Integer
Dim strExt As String
‘ remove disallowed characters
strBadChars = « \/:*?<>| » & Chr(34)
For i = 1 To Len(strBadChars)
strText = Replace(strText, Mid(strBadChars, i, 1), «  »)
Next
‘ split into name and file extension
intPos = InStrRev(strText, « . »)
If intPos >= 2 Then
strExt = Mid(strText, intPos + 1)
strText = Left(strText, intPos – 1)
End If
‘ clip to allowed length
strText = Left(strText, 215 – Len(strExt))
‘ reassemble parts
If intPos >= 2 Then
strText = strText & « . » & strExt
End If
ValidFileName = strText
End Function

Téléchargez gratuitement cette ressource

IBMi et Cloud : Table ronde Digitale

IBMi et Cloud : Table ronde Digitale

Comment faire évoluer son patrimoine IBMi en le rendant Cloud compatible ? Comment capitaliser sur des bases saines pour un avenir serein ? Faites le point et partagez l'expertise Hardis Group et IBM aux côtés de Florence Devambez, DSI d'Albingia.

Tech - Par iTPro - Publié le 24 juin 2010