主题:高手帮忙看一下:VB 调用默认的邮件客户端发邮件
blackholepro
[专家分:0] 发布于 2008-08-13 16:06:00
VB中调用系统默认的邮件客户端发邮件时,我用的是mailto函数,但在这个函数对Body有1024字符限制而且不能添加附件一起发送,不知道还有没有别的函数能够实现这个功能,百度Google了一堆没有结果,要求是能添加附件,调用客户端的默认邮件系统,请高手指点!!!谢谢!
回复列表 (共10个回复)
沙发
我是大喊三 [专家分:3010] 发布于 2008-08-13 19:03:00
mailto是函数吗?还没用过。
板凳
blackholepro [专家分:0] 发布于 2008-08-13 20:00:00
Create the URL
URL = "mailto:" & Email & "?cc=" & CC & " " & abc & "&subject=" & Subj & "&body=" & Msg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
就是用以上代码,但是不能添加附件,要是能添加附件的话我只知道用:olApp = New Outlook.Application, 但是这个代码指定了用outlook来发送,要是用户使用foxmail或者note等其他的邮件系统就不行了。还有其他办法调用系统默认的邮件来发送带附件的邮件吗?
3 楼
一江秋水 [专家分:9680] 发布于 2008-08-13 20:00:00
还可以使用API函数ShellExecute来调用默认邮件客户端:
ST1="北京奥运会"
ST2="号外"
i = ShellExecute(Me.hWnd, "open", "mailto:?subject=" & ST1 & "&Body=" & St2, vbNullString, vbNullString, 1)
4 楼
blackholepro [专家分:0] 发布于 2008-08-13 20:09:00
用shellexcute的话没办法添加附件,还有别的方法调用系统默认的邮件吗?
5 楼
blackholepro [专家分:0] 发布于 2008-08-13 20:12:00
用MAPI行吗?没用过。。。。
6 楼
blackholepro [专家分:0] 发布于 2008-08-14 11:35:00
搞定了,用MAPI可以的,代码如下:
Option Explicit
Private Type MAPIMessage 'Mail
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type
Private Type MapiRecip 'Recipient
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
Private Type MapiFile 'File
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0
Private Const MAPI_USER_ABORT = 1
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Private Const MAPI_E_FAILURE = 2
Private Const MAPI_E_LOGIN_FAILURE = 3
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Private Const MAPI_E_DISK_FULL = 4
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5
Private Const MAPI_E_BLK_TOO_SMALL = 6
Private Const MAPI_E_TOO_MANY_SESSIONS = 8
Private Const MAPI_E_TOO_MANY_FILES = 9
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14
Private Const MAPI_E_BAD_RECIPTYPE = 15
Private Const MAPI_E_NO_MESSAGES = 16
Private Const MAPI_E_INVALID_MESSAGE = 17
Private Const MAPI_E_TEXT_TOO_LARGE = 18
Private Const MAPI_E_INVALID_SESSION = 19
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Private Const MAPI_E_MESSAGE_IN_USE = 22
Private Const MAPI_E_NETWORK_FAILURE = 23
Private Const MAPI_E_INVALID_EDITFIELDS = 24
Private Const MAPI_E_INVALID_RECIPS = 25
Private Const MAPI_E_NOT_SUPPORTED = 26
Private Const MAPI_ORIG = 0 'Recipient-Flags
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_FORCE_DOWNLOAD = &H1000
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0
Private Const MAPI_OLE = &H1
Private Const MAPI_OLE_STATIC = &H2
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2
Private Const MAPI_SENT = &H4
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal User As String, ByVal Password As String, ByVal Flags As Long, _
ByVal Reserved As Long, Session As Long) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, _
ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" _
(ByVal Session As Long, ByVal UIParam As Long, Message As MAPIMessage, _
Recipient() As MapiRecip, File() As MapiFile, ByVal Flags As Long, _
ByVal Reserved As Long) As Long
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal DelimStr As String, ByVal FilePaths As String, ByVal FileNames As String, _
ByVal Reserved As Long) As Long
'---------------------------------------------------------------------------
7 楼
blackholepro [专家分:0] 发布于 2008-08-14 11:35:00
Function SendIt(sRecip As String, sTitle As String, sText As String, sFile As String) As Boolean
Dim strTemp As String
Dim strError As String
Dim lngIndex As Long
Dim iFileCount As Integer
Dim mRecip(0) As MapiRecip, mFile() As MapiFile, mMail As MAPIMessage
Dim lSess As Long, lRet As Long
On Error GoTo ErrorHandler
SendIt = False
'Add 2 trailing spaces to the text, this will be the position where the attachment goes to
sText = sText & " "
'Recipient
With mRecip(0)
.Name = sRecip
.RecipClass = MAPI_TO
End With
'File to send?
If sFile <> "" Then
ReDim mFile(0)
With mFile(0)
.FileName = sFile
.PathName = sFile
.Position = Len(sText) - 1
.FileType = ""
.Reserved = 0
End With
iFileCount = 1
End If
'Create Mail
With mMail
.Subject = sTitle
.NoteText = sText
.Flags = 0
.FileCount = iFileCount
.RecipCount = 1
.Reserved = 0
.DateReceived = ""
.MessageType = ""
End With
'Post it
'Logon: User = "" and Password = ""
lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess)
If lRet <> SUCCESS_SUCCESS Then
strError = "Error logging into messaging software. (" & CStr(lRet) & ")"
GoTo ErrorHandler
End If
'Send the mail to the given recipients with the attached file without showing a dialog
lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0)
If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then
If lRet = 14 Then
strError = "Recipient not found"
Else
strError = "Error sending: " & CStr(lRet)
End If
GoTo ErrorHandler
End If
lRet = MAPILogoff(lSess, 0, 0, 0)
SendIt = True
Exit Function
ErrorHandler:
If strError = "" Then strError = Err.Description
Call MsgBox(strError, vbExclamation, "MAPI-Error")
End Function
'------------------------------------------------------------------------------------------------
Sub eMailActiveWorkbook()
Dim Wb As Workbook
Application.ScreenUpdating = False
Set Wb = ActiveWorkbook
Wb.Save
SendIt "me@here.com", "A new Document", "Hi, read this:", Wb.FullName
Application.ScreenUpdating = True
Set Wb = Nothing
End Sub
8 楼
blackholepro [专家分:0] 发布于 2008-08-14 11:36:00
谢谢大家!!![em12]
9 楼
snyga [专家分:1480] 发布于 2008-08-14 14:15:00
'SendMail 标题, 内容, 要发送到的邮箱, 用来发送信件的邮箱, 用来发送信件的邮箱密码, [附件路径], [是否显示出错信息]
Private Function SendMail(Title As String, _
Matter As String, _
ToEmail As String, _
FormEmail As String, _
EmailPassWord As String, _
Optional AffixPath As String, _
Optional ShowErrInfo As Boolean = True) _
As Boolean
Dim NameS As String
Dim Email As Object
Dim p() As String
On Error GoTo err1
NameS = "http://schemas.microsoft.com/cdo/configuration/"
p = Split(FormEmail, "@")
Set Email = CreateObject("CDO.Message")
With Email
.From = FormEmail '用来发送信件的邮箱
.To = ToEmail '要发送到的邮箱
.Subject = Title '标题
.Textbody = Matter '内容
If Dir(AffixPath, vbHidden) <> "" And _
Len(Trim(AffixPath)) > 0 Then .AddAttachment AffixPath '本地附件地址(绝对地址)
With .Configuration.Fields
.Item(NameS & "sendusing") = 2
.Item(NameS & "smtpserver") = "smtp." & p(1) 'SMTP服务器
.Item(NameS & "smtpserverport") = 25
.Item(NameS & "smtpauthenticate") = 1
.Item(NameS & "sendusername") = p(0) '用户名
.Item(NameS & "sendpassword") = EmailPassWord '密码
.Update
End With
.Send
End With
err1:
If Not Err Then
SendMail = True
ElseIf ShowErrInfo = True Then
MsgBox Err.Description, vbCritical, "错误!"
End If
End Function
10 楼
guoyong_cy [专家分:3050] 发布于 2008-08-14 23:39:00
什么目的??
不要发病毒到我邮箱哈!!!
我来回复