ITPUB论坛 » IBM软件技术精英协会 » 发送MEMO邮件，附件出错误
2007-11-12 15:12
yunbozhang
发送MEMO邮件，附件出错误
我用以下代码发邮件时，对方收到邮件时附件名称如果是中文的则附件名称中每个中文后有一个！，但是可以下载和打开，请问是代码问题还是服务器配置问题
Dim s As New NotesSession
Dim db As NotesDatabase
Dim body As NotesMIMEEntity, bodyChild As NotesMimeEntity
Dim header As NotesMIMEHeader
Dim rtiWeb As NotesRichTextItem
Dim message As NotesDocument
Dim stream As NotesStream
Set Db=s.CurrentDatabase
s.ConvertMIME = False ' Do not convert MIME to rich text
Set message=s.DocumentContext
message.Form = "memo"
message.Subject = message.WebSubject
If message.HasItem("body") Then
Call message.RemoveItem("body")
End If
Set body = message.CreateMIMEEntity
Set rtiWeb=message.GetFirstItem("body1")
Set stream = s.CreateStream()
Call stream.WriteText ("<html><head><title>"+message.subject(0)+"</title></head>")
Call stream.WriteText ({<body text="#666666" bgcolor="#FFFFFF" leftmargin="0" topmargin="0" marginheight="0" marginwidth="0">})
Call stream.WriteText(rtiWeb.GetFormattedText(0,0))
Call stream.WriteText ({</body></html>})
Set bodyChild = body.CreateChildEntity()
Call bodyChild.SetContentFromText (stream, "text/html;charset=UTF-8",ENC_NONE)
Call stream.Close
Call stream.Truncate
If message.HasEmbedded Then
'附件
Dim fptpath As String
Dim pathName As String, fileName As String
Dim docid As String
docid=message.UniversalID
ftppath = "D:\Lotus\FTP\send"
ftppath = ftppath+"\"+docid
fileName$ =""
fileName$ =Dir(ftppath, 16)
If fileName$="" Then
Mkdir ftppath
End If
Emb=Evaluate(|@AttachmentNames|,message)
For j=Lbound(Emb) To Ubound(Emb)
Set Object=message.GetAttachment(emb(j))
Call Object.ExtractFile( ftppath+"\"+emb(j))
Call Object.Remove
Next
pathName$ = ftppath+"\*.*"
fileName$ = Dir$(pathName$, 0)
Do While fileName$ <> ""
Set bodyChild = body.CreateChildEntity()
Set header = bodyChild.createHeader("Content-Transfer-Encoding")
Call header.setHeaderVal("base64")
Set header = bodyChild.createHeader("Content-Type")
Call header.setHeaderVal("multipart/mixed;charset=gb2312")
Msgbox ">>>>>>"+fileName$
Msgbox "Encode"+Cstr(bodyChild.Encoding)
Set header = bodyChild.createHeader("Content-Disposition")
'Call header.setHeaderValAndParams( |attachment; filename="|+fileName$+|"| )
Call header.SetHeaderVal( |attachment; filename="|+fileName$+|"| )
Set header = bodyChild.createHeader("Contet-ID")
Call header.setHeaderVal( |"|+fileName$+|"| )
Set stream = s.CreateStream()
If Not stream.Open(ftppath+"\"+fileName$,"binary") Then
Print "Open failed"
End If
If stream.Bytes = 0 Then
Print "File has no content"
End If
Call bodyChild.SetContentFromBytes(stream, "Content-Type", ENC_IDENTITY_BINARY)
Call stream.Close
Call stream.Truncate
Kill ftppath+"\"+fileName$
fileName$ = Dir$()
Loop
Rmdir ftppath
End If
Call message.Send (False)
我用以下代码发邮件时，对方收到邮件时附件名称如果是中文的则附件名称中每个中文后有一个！，但是可以下载和打开，请问是代码问题还是服务器配置问题
Dim s As New NotesSession
Dim db As NotesDatabase
Dim body As NotesMIMEEntity, bodyChild As NotesMimeEntity
Dim header As NotesMIMEHeader
Dim rtiWeb As NotesRichTextItem
Dim message As NotesDocument
Dim stream As NotesStream
Set Db=s.CurrentDatabase
s.ConvertMIME = False ' Do not convert MIME to rich text
Set message=s.DocumentContext
message.Form = "memo"
message.Subject = message.WebSubject
If message.HasItem("body") Then
Call message.RemoveItem("body")
End If
Set body = message.CreateMIMEEntity
Set rtiWeb=message.GetFirstItem("body1")
Set stream = s.CreateStream()
Call stream.WriteText ("<html><head><title>"+message.subject(0)+"</title></head>")
Call stream.WriteText ({<body text="#666666" bgcolor="#FFFFFF" leftmargin="0" topmargin="0" marginheight="0" marginwidth="0">})
Call stream.WriteText(rtiWeb.GetFormattedText(0,0))
Call stream.WriteText ({</body></html>})
Set bodyChild = body.CreateChildEntity()
Call bodyChild.SetContentFromText (stream, "text/html;charset=UTF-8",ENC_NONE)
Call stream.Close
Call stream.Truncate
If message.HasEmbedded Then
'附件
Dim fptpath As String
Dim pathName As String, fileName As String
Dim docid As String
docid=message.UniversalID
ftppath = "D:\Lotus\FTP\send"
ftppath = ftppath+"\"+docid
fileName$ =""
fileName$ =Dir(ftppath, 16)
If fileName$="" Then
Mkdir ftppath
End If
Emb=Evaluate(|@AttachmentNames|,message)
For j=Lbound(Emb) To Ubound(Emb)
Set Object=message.GetAttachment(emb(j))
Call Object.ExtractFile( ftppath+"\"+emb(j))
Call Object.Remove
Next
pathName$ = ftppath+"\*.*"
fileName$ = Dir$(pathName$, 0)
Do While fileName$ <> ""
Set bodyChild = body.CreateChildEntity()
Set header = bodyChild.createHeader("Content-Transfer-Encoding")
Call header.setHeaderVal("base64")
Set header = bodyChild.createHeader("Content-Type")
Call header.setHeaderVal("multipart/mixed;charset=gb2312")
Msgbox ">>>>>>"+fileName$
Msgbox "Encode"+Cstr(bodyChild.Encoding)
Set header = bodyChild.createHeader("Content-Disposition")
'Call header.setHeaderValAndParams( |attachment; filename="|+fileName$+|"| )
Call header.SetHeaderVal( |attachment; filename="|+fileName$+|"| )
Set header = bodyChild.createHeader("Contet-ID")
Call header.setHeaderVal( |"|+fileName$+|"| )
Set stream = s.CreateStream()
If Not stream.Open(ftppath+"\"+fileName$,"binary") Then
Print "Open failed"
End If
If stream.Bytes = 0 Then
Print "File has no content"
End If
Call bodyChild.SetContentFromBytes(stream, "Content-Type", ENC_IDENTITY_BINARY)
Call stream.Close
Call stream.Truncate
Kill ftppath+"\"+fileName$
fileName$ = Dir$()
Loop
Rmdir ftppath
End If
Call message.Send (False)
2007-11-12 22:25
8bit_name
因为Domino对中文的编码方式不同，所以你可能这么直接生成的中文名字可能会有问题吧，又是UTF-8又是GB2312的，为什么不直接用HTML标签中的<A href=...这样写呢？
或者你试试直接在notes里面编辑后，产生的HTML代码是怎样的，包括附件的代码，看看能不能模拟出来？
或者你试试直接在notes里面编辑后，产生的HTML代码是怎样的，包括附件的代码，看看能不能模拟出来？
页: [1]
查看完整版本: 发送MEMO邮件，附件出错误
Powered by ITPUB论坛