Group Blog
 
 
กรกฏาคม 2550
 
1234567
891011121314
15161718192021
22232425262728
293031 
 
4 กรกฏาคม 2550
 
All Blogs
 

Script ส่ง E-mail จาก MS Outlook ไป Sharepoint Service 2.0

Option Explicit
' See //support.microsoft.com/?kbid=306108


Const DocumentLibrary = "//spsMyWorld/sites/testing/my_library/" ' <<<< Document Library ที่เราต้องการจะเก็บ


Sub MoveMailtoDocLib(Item As Outlook.MailItem)
Dim safeFileName As String: safeFileName = CreateSafeFileName(Item.Subject) ' <<< ใช้ Subject สร้างเป็นชื่อ file
Dim dateString As String: dateString = Format(Now, "-yyyymmdd-hhmmss")
Dim fullFileName As String: fullFileName = DocumentLibrary & safeFileName & dateString & ".msg" ' <<<< ชื่อเต็มของ File
Dim saveAsType As OlSaveAsType: saveAsType = Outlook.OlSaveAsType.olMSGUnicode
Item.SaveAs fullFileName, saveAsType
End Sub

Sub CustomMailMessageRule(Item As Outlook.MailItem)

Dim Extension As String
Dim saveAsType As OlSaveAsType
If Item.BodyFormat = olFormatHTML Then
saveAsType = olHTML
Extension = ".htm"
ElseIf Item.BodyFormat = olFormatPlain Then
saveAsType = olTXT
Extension = ".txt"
ElseIf Item.BodyFormat = olFormatRichText Then
saveAsType = olRTF
Extension = ".doc"
End If

Dim safeFileName As String: safeFileName = CreateSafeFileName(Item.Subject)
Dim dateString As String: dateString = Format(Now, "-yyyymmdd-hhmmss")
Dim fullFileName As String: fullFileName = DocumentLibrary & safeFileName & dateString & Extension

Item.SaveAs fullFileName, saveAsType

End Sub

' This sample code from //www.thegamblefamily.net/codelib/ShowCode_Container.asp?RecordID=643
Function CreateSafeFileName(strFilename)

Dim strTmp

strTmp = Replace(strFilename, "\", "_")
strTmp = Replace(strTmp, ".", "_")
strTmp = Replace(strTmp, "/", "_")
strTmp = Replace(strTmp, ":", "_")
strTmp = Replace(strTmp, "*", "_")
strTmp = Replace(strTmp, "?", "_")
strTmp = Replace(strTmp, """", "_")
strTmp = Replace(strTmp, "<", "_")
strTmp = Replace(strTmp, ">", "_")
strTmp = Replace(strTmp, "|", "_")
strTmp = Replace(strTmp, "%", "_")
strTmp = Replace(strTmp, "#", "_")
strTmp = Replace(strTmp, ";", "_")
strTmp = Replace(strTmp, "@", "_")
strTmp = Replace(strTmp, "&", "_")
strTmp = Replace(strTmp, "=", "_")
strTmp = Replace(strTmp, "~", "_")

CreateSafeFileName = strTmp

End Function

' Remarks
' ต้องมาคอยเปิดMS Outlook ค้างไว้ด้วยนะ เพราะเป็น client script
' เอามาจากไหนไม่รู้จำไม่ได้แล้ว
' MoveMailtoDocLib = version ดัดแปลงให้เก็บทั้ง mail ลง ระบบ
' CustomMailMessageRule = ต้นฉบับ




 

Create Date : 04 กรกฎาคม 2550
1 comments
Last Update : 4 กรกฎาคม 2550 7:58:01 น.
Counter : 494 Pageviews.

 

 

โดย: โสมรัศมี 4 กรกฎาคม 2550 8:09:17 น.  

ชื่อ : * blog นี้ comment ได้เฉพาะสมาชิก
Comment :
  *ส่วน comment ไม่สามารถใช้ javascript และ style sheet
 
รหัสส่งข้อความ
กรุณายืนยันรหัสส่งข้อความ


อุ๊บอิ๊บน้อย
Location :
กรุงเทพ Thailand

[ดู Profile ทั้งหมด]

ให้ทิปเจ้าของ Blog [?]
ฝากข้อความหลังไมค์
Rss Feed

ผู้ติดตามบล็อก : 2 คน [?]




Friends' blogs
[Add อุ๊บอิ๊บน้อย's blog to your web]
Links
 

 Pantip.com | PantipMarket.com | Pantown.com | © 2004 BlogGang.com allrights reserved.