关于用vba新建邮件并添加附件的问题！！

oki4

Function GetBoiler(ByVal sFile As String) As String

  Dim fso As Object

  Dim ts As Object

  Set fso = CreateObject("Scripting.FileSystemObject")

  Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

  GetBoiler = ts.readall

  ts.Close

End Function



Private Sub CommandButton1_Click()

  Dim OutApp As Object

  Dim OutMail As Object

  Dim strbody, strbody1, strbody2, strbody8 As String

  Dim SigString As String

  Dim Signature As String

  Dim acc, bcc, bccx, nn, strx, strn

  Dim rngDest As Range, arr

  Set OutApp = CreateObject("Outlook.Application")

  Set OutMail = OutApp.CreateItem(0)

  strbody8 = "邮件内容~<br>" & _

     "<br><br><B>邮件内容</B>"  '输入邮件内容

  SigString = Environ("appdata") & _

"\Microsoft\Signatures\建立新邮件.htm"

  If Dir(SigString) <> "" Then

  Signature = GetBoiler(SigString)

  Else

  Signature = ""

  End If



  On Error Resume Next





  With OutMail

  .To = "123@163.com" '主送



  .Subject = "输入邮件主题"         '主题

  .HTMLBody = strbody8 & "<br><br>" & Signature  'html格式正文

  .display              '在Outlook界面显示该封待发送邮件

  .Attachments.Add ThisWorkbook.FullName    '附件

  End With

  On Error GoTo 0



  Set OutMail = Nothing

  Set OutApp = Nothing

End Sub

以上，在EXCEL中添加按钮，可自动新建邮件，并将EXCEL存为附件。
我的问题是：如果想“新建约会”的话要怎么改？

oki4

顶一个~~~~~~~~~~~

oki4

有人会吗…只要在以上代码中加入“添加提醒”这个功能就行了………
会的帮个忙吧