|
成品如下：
kajCkE59.rar
(24.46 KB, 下载次数: 57)
注意几个问题：WORD的宏安全性必须设置为低，否则，无法运行！
OUTLOOK最好是在打开状态下，以便及时真正发送（以下代码中只是发送到发件箱，不能真正发送，需要确认）
以下代码供参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-5-6 7:08:19
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub CleanAll_Click()
Dim aInlineShape As InlineShape, ControlName As String
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕更新
'在文档的嵌入式图形中循环
For Each aInlineShape In ThisDocument.InlineShapes
'获得OLE链接对象的名称
ControlName = aInlineShape.OLEFormat.Object.Name
'如果为文本框
If VBA.InStr(ControlName, "Text") > 0 Then
'将其文本清空
aInlineShape.OLEFormat.Object.Value = ""
ElseIf VBA.InStr(ControlName, "Check") > 0 Then
'如果为复选框,设置其值为FALSE,即不选定
aInlineShape.OLEFormat.Object.Value = False
'如果为单选按钮,设置其值为FALSE,即不选定
ElseIf VBA.InStr(ControlName, "Option") > 0 Then
aInlineShape.OLEFormat.Object.Value = False
End If
Next
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
'----------------------
Private Sub OK_Click()
Dim Ck1 As Boolean, Ck2 As Boolean
'取得两个关键复选框的值
Ck1 = Me.CheckBox1.Value: Ck2 = Me.CheckBox11.Value
If Ck1 = False And Ck2 = False Then
MsgBox "您未正确填写全部的必填项!", vbExclamation: Exit Sub
ElseIf Ck2 = True Or (Ck1 = True And Ck2 = True) Then
If NameTextBx = "" Or TelTextBx = "" Or FaxTextBx = "" Or PeopleTextBx = "" Or _
CompanyTextBx = "" Or CallingTextBx = "" Then MsgBox "您未正确填写全部的必填项!", vbInformation: _
Exit Sub
ElseIf Ck1 = True Then
If NameTextBx = "" Or TelTextBx = "" Or FaxTextBx = "" Or PeopleTextBx = "" Then _
MsgBox "您未正确填写全部的必填项!", vbInformation: Exit Sub
End If
Me.Save
Call MailerTest
End Sub
'----------------------
Sub MailerTest()
Dim MyOlApp As Object, ObjMail As Object
On Error Resume Next
'创建一个后期绑定的OUTLOOK程序对象
Set MyOlApp = CreateObject("Outlook.Application")
'创建一个新邮件
Set ObjMail = MyOlApp.CreateItem(0)
With ObjMail
.To = "shourou_8@hotmail.com" '收件人
' .cc = "SomebodyElse@hotmail.com"
.Subject = "TEST EMAIL" '主题
.Body = "THIS IS THE BODY" '正文
.NoAging = True
.Attachments.Add (ThisDocument.FullName) '附加文件
.Display '显示
' .Send '如果是直接发送,将会出现确认对话框
End With
Set ObjMail = Nothing
Set MyOlApp = Nothing
SendKeys "%{s}", True '发送
End Sub
'---------------------- | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-5-5 13:53
楼主
