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

endColumnNo = ActiveSheet.UsedRange.Columns.Count

MyItem.Send

On Error Resume Next

For A = 1 To endColumnNo

TextBox1.Value = &34;&34;

&39;清空文本框

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

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

Dim objMail As MailItem

Next

MyItem.To = Cells(rowCount, 2)

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;

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;

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

Dim myAttachments As outlook.Attachments

MyItem.Attachments.Add (TextBox1.Value)

&39;自动发送邮件

B = 1

B = 0

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

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

sFile1 = ActiveSheet.Name

Set objMail = Nothing

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

End If

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

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

End If

End With

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

End Sub

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

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

Next

Else

endRowNo = ActiveSheet.UsedRange.Rows.Count

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

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

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

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

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

MyItem.Display

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

Set MyItem = Nothing

Private Sub CommandButton1_Click()

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

If B = 1 Then

B = 1

Dim MyItem As outlook.MailItem

MsgBox &34;发送邮件&34;

End If

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

Set objOutlook = Nothing

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

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

End Sub

End

For rowCount = 2 To endRowNo

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

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

Dim arr()

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

With objMail

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

Else

TextBox1.Value = arr(i)

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

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

Next

&39;销毁objOutlook对象

Set objMail = objOutlook.CreateItem(olMailItem)

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

&39;销毁objMail对象

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

&39; .HTMLBody = sFile

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

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

Dim objOutlook As Object

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

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

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