所以我一直试图想出一个宏来通过电子表格发送附件的电子邮件。
例如:
mailto:[email protected]?subject=Sample12345
如果我在excel中使用上述字符串,它将提示我的默认电子邮件客户端使用示例电子邮件地址和示例主题行创建电子邮件。我已经使用了一段时间它可能是简单的字符串但是,当我可以在excel中操作它时它非常有用。
单元格中字符串操作的示例:=HYPERLINK(A1&A2&A3&A4&A5&A6)
我想改变相同的概念,但在宏中,所以我可以将它发送给具有不同电子邮件地址的多个人。
问题:
我将Lotus Notes Social Edition Home作为默认电子邮件客户端 - 版本9.0.1
我想要完成的例子:
Mailto: [email protected] (from a specific cell value in excel "=Sheet1!A1")
CC:( from a specific cell value in excel "=Sheet1!A2" )
Body: ( from a specific Range in excel "=Sheet2!A1:B24" )
Attachment : (from a specific cell value in excel "=Sheet1!A1") ....Value in Cell - " C:\Users\User1\Downloads\sampleexcelsheet.xlsm "
让我知道你的想法。
谢谢!。
这是发送电子邮件的一种更简单的方式。它适用于我,我有Lotus Notes 9,所以希望它也适用于您的版本。
Sub Send_Email_via_Lotus()
'Send an e-mail & attachment using Lotus Not(s)
'Original Code by Nate Oliver (NateO)
'Declare Variables for file and macro setup
'Dim AVal As Variant
Dim UserName As String, MailDbName As String, ccRecipient As String, Recipient As String
Dim Maildb As Object, MailDoc As Object, Session As Object
Dim email As String, bodyText As String, clientRef As String, bodyRng As Range, emailBody As String
Dim notesUIDoc As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Call Maildb.OPENMAIL
End If
Recipient = Sheets("Sheet1").Range("A1").Value
ccRecipient = Sheets("Sheet1").Range("A2").Value
Set bodyRng = Sheets("Sheet2").Range("A1:B24")
Dim cel As Range
For Each cel In bodyRng
emailBody = emailBody & " " & cel.Value
Next cel
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.sendTo = Recipient
MailDoc.CopyTo = ccRecipient
MailDoc.Subject = "SUBJECT HERE"
'Displays email message without sending; user needs to click Send
Set workspace = CreateObject("Notes.NotesUIWorkspace")
Set notesUIDoc = workspace.EditDocument(True, MailDoc)
'Call notesUIDoc.FieldClear("Body") '' This line will clear the ENTIRE body, including signature.
Call notesUIDoc.gotofield("Body") 'This should just Go to the body, keeping your signature.
Call notesUIDoc.FieldAppendText("Body", emailBody)
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
'End If
Exit Sub
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Application.EnableEvents = True
End Sub
请注意,附件部分缺乏,我将继续搜索,但这应该让你开始,看看如何使用变量来设置正文,收件人等(可能还有不必要的变量,我没有'检查那些)。
注意:请查看For Each cel in bodyRng
循环,因为我不太清楚你想要如何设置身体。
Sub NotesEmailrun()
Dim UserName As String, MailDbName As String, ccRecipient As String, attachment1 As String
Dim Maildb As Object, MailDoc As Object, AttachME As Object, Session As Object
Dim EmbedObj1 As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", "")
If Maildb.IsOpen = True Then
Else
Maildb.OpenMail
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.Sendto = Sheets("Sheet1").Range("A1").Value
MailDoc.CopyTo = Sheets("Sheet1").Range("A2").Value
MailDoc.Subject = Sheets("Sheet1").Range("A5").Value
MailDoc.body = Sheets("Sheet2").Range("A1:H24")
MailDoc.SaveMessageOnSend = True
attachment1 = "C:\Users\Username\Desktop\folder1\time.txt"
If attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment1)
On Error Resume Next
End If
attachment2 = "C:\Users\username\Desktop\folder2\time2.txt"
If attachment2 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment2")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment2)
On Error Resume Next
End If
Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EditDocument(True, MailDoc).GOTOFIELD("Body")
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub