- 帖子
- 215
- 主題
- 70
- 精華
- 0
- 積分
- 290
- 點名
- 0
- 作業系統
- window xp
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2012-6-27
- 最後登錄
- 2024-1-29
|
大大, 下列是一個可以發送電郵附件的程式, 想加入一個WORKSHEETS("EMAIL"), 內A欄是SHEET NAME, B欄是電郵地址, 如果SHEET NAME = A欄內SHEET NAME, 則下列TO 的EMAIL ADDRESS取B欄, 但有多張SHEETS :,- Sub saveoneshop_email_3()
- Dim xPath As String
- Dim F As String
- Dim Sheetname As String
- Dim savesheet As Object
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- xPath = Application.ActiveWorkbook.Path
- F = InputBox
- If F = "" Then Exit Sub
- Sheetname = InputBox
- If Sheetname = "" Then Exit Sub
- Set savesheet = ActiveWorkbook.Worksheets(Sheetname)
- savesheet.Copy
- Set savesheet = ActiveWorkbook
- savesheet.SaveAs Filename:=xPath & "\" & Sheetname & "_" & F & ".xlsx"
-
- Dim Mail_Object, Mail_Single As Variant
- Dim contact As String
- contact = "[email protected]"
- Email_Subject = Sheetname & "_" & F & "表"
- Email_Cc = ""
- Email_Bcc = ""
- Email_Body = "XX"
- Set Mail_Object = CreateObject("Outlook.Application")
- Set Mail_Single = Mail_Object.CreateItem(o)
- With Mail_Single
- .Subject = Email_Subject
- .To = Email_Send_To
- .CC = Email_Cc
- .BCC = Email_Bcc
- .Body = Email_Body
- .Attachments.Add (xPath & "\" & Sheetname & "_" & F & ".xlsx")
- .Display
- '.send
- End With
- savesheet.Close
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2015-8-25 21:13
| 
