qq邮箱超大附件（qq邮箱怎么避免超大附件）

If TextBox1.Value = &34;&34; Then

Dim MyItem As outlook.MailItem

If B = 1 Then

MyItem.Subject = Format(Date, &34;yyyy年m月d日&34;) + &34;测试&34;

Dim objOutlook As Object

Set objMail = Nothing

&39; Sheet1.Shapes(&34;全自动发送邮件&34;).Delete

&39;设定邮件模板所在的位置

Dim rowCount, endRowNo, endColumnNo, sFile$, sFile1$, A&, B&

endRowNo = ActiveSheet.UsedRange.Rows.Count

Next

End Sub

Set MyItem = Nothing

&39;多OUTLOOK账号设定所发送的邮箱序列（1为第一个，2为第二个）

MsgBox rowCount - 2 & &34; 份订单发送成功！&34;

Set MyItem = objOutlook.CreateItemFromTemplate(&34;d:\02.oft&34;)

&39;设置邮件内容(从通讯录表的“内容”字段中获得)

End If

MyItem.Attachments.Add (TextBox1.Value)

On Error Resume Next

For i = LBound(arr) To UBound(arr)

&39;MyItem.CC = &34;11111@qq.com;222222@qq.com&34;

Else

&39;取得当前工作表数据区行数列数

B = 1

MyItem.Send

TextBox1.Value = arr(i)

&39;创建objOutlook为Outlook应用程序对象

&39;colSpan是一种编程语言，其属性可设置或返回表元横跨的列数

End With

End Sub

With objMail

Else

&39;取得当前工作表的名称，用来作为邮件主题进行发送

MyItem.To = Cells(rowCount, 2)

&39;邮件的内容，这里取上面路径中邮件模板中的内容

For A = 1 To endColumnNo

&39;要能正确发送并需要对Microseft Outlook进行有效配置

&39; .Attachments.Add (TextBox1.Value)

Next

End If

&39;设置附件(从被选择的路径选取)

sFile = sFile + &34;<tr><Font Face=&39;微软雅黑&39; Color=red> <td width=&39;20%&39; height=&39;25&39; align=&39;center&39; > &34; + Cells(1, A).Text + &34; </td> <td width=&39;30%&39; height=&39;25&39; align=&39;center&39;> &34; + Cells(rowCount, A).Text + &34;</td>&34;

B = 1

&39;数据表头中添加“X”后将不发送此字段

&39;设置抄送人地址（从通讯录表的&39;E-mail地址&39;字段中获得）

Next

If Application.WorksheetFunction.CountIf(Cells(1, A), &34;*X*&34;) = 0 Then

Dim objMail As MailItem

&39;所有电子邮件发送完成时提示

Set objMail = objOutlook.CreateItem(olMailItem)

Private Sub 全自动发送邮件_Click()

&39;所发送邮件的附件的路径

&39;设置邮件主题,取值工作表名，

&39;设置收件人地址，数据源所在列数

For rowCount = 2 To endRowNo

endColumnNo = ActiveSheet.UsedRange.Columns.Count

Set objOutlook = Nothing

sFile = sFile + &34;<td width=&39;20%&39; height=&39;25&39; align=&39;center&39; > &34; + Cells(1, A).Text + &34; </td> <td width=&39;30%&39; height=&39;25&39; align=&39;center&39;> &34; + Cells(rowCount, A).Text + &34;</td> </tr>&34;

Private Sub CommandButton1_Click()

&39;销毁objOutlook对象

&39;创建objMail为一个邮件对象

&39;开始循环发送电子邮件

Dim myAttachments As outlook.Attachments

MyItem.Display

End If

&39; .HTMLBody = sFile

&39;销毁objMail对象

&39;align 单元格文本显示方式 left(向左)、center(居中)、right(向右)，默认是center, width-宽 height-高 border 单元格线粗细,bordercolor返回或设置对象的边框颜色

TextBox1.Value = &34;&34;

sFile1 = ActiveSheet.Name

Dim arr()

MsgBox &34;未选择文件&34;

&39;清空文本框

MyItem.SendUsingAccount = objMail.Session.Accounts.Item(1)

Set objOutlook = CreateObject(&34;Outlook.Application&34;)

B = 0

&39;自动发送邮件

End

MsgBox &34;发送邮件&34;

arr = Application.GetOpenFilename(&34;所有支持文件 (*.xls;*.xlsx;*.csv),*.xls;*.xlsx;*.csv,Excel 文件 (*.xls),*.xls,Excel2007 文件 (*.xlsx),*.xlsx,CSV 文件 (*.csv),*.csv&34;, , &34;选择文件&34;, , True)