[AP] 取得附件的副檔名

 %REM

Function SP_getFileExtension

Description: 20260128 added, 取得附件的副檔名

傳入document, 附檔欄位名稱

%END REM

Function SP_getFileExtension(doc As NotesDocument, xFieldName As String) As Variant

On Error GoTo errorhandler

Dim session As New NotesSession

Dim db As NotesDatabase

Set db = session.Currentdatabase

'

Dim attachments As Variant

Dim attachmentName As String

Dim ext As String

ReDim vFileExtension(0) As String

Dim i As Integer

'

Dim mbdcount As Integer,plaintext As String

Dim rtitem As Variant

mbdcount =0 ' initialize

Set rtitem = doc.GetFirstItem(xFieldName)

If ( rtitem.Type = RICHTEXT ) Then

plainText = rtitem.GetFormattedText( False, 0 ) ' render the Rich item into text this gets all text values and ignores attachments/OLE

If Len(plaintext) < 1 Then

'i = 0

If IsArray(rtitem.EmbeddedObjects) Then

ForAll o In rtitem.EmbeddedObjects ' loop through array of embedded objects in the rich text item

ReDim Preserve vFileExtension(mbdcount) As String

attachmentName = o.Name

ext = StrRightBack(attachmentName, ".")  '// 傳入附檔名稱

Print "Attachment >>> " + attachmentName + " has extension: "  + ext

vFileExtension(mbdcount) = ext

mbdcount=mbdcount+1 ' there is at least one emb object

End ForAll

End If

End If

End If

SP_getFileExtension = vFileExtension 

%REM

If (doc.HasEmbedded) Then

attachments = doc.EmbeddedObjects

ForAll obj In attachments

If obj.Type = EMBED_ATTACHMENT Then

attachmentName = obj.Name

ext = StrRightBack(attachmentName, ".")  '// 傳入附檔名稱

Print "Attachment >>> " + attachmentName + " has extension: "  + ext

End If

End ForAll

End If

%END REM

TheEnd:

Exit Function

ErrorHandler:

Dim strErr As String

strErr = "Library: SP_UtilityLib / SP_getFileExtension has error! line = " + CStr(Erl) + ", error = " + Error$

Print strErr

MessageBox strErr, 48, "Warning"

Resume TheEnd

End Function