- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 11# missbb
試試看- Option Explicit
- Sub ex()
- Set d = CreateObject("Scripting.Dictionary")
- With Worksheets("attendance report")
- For Each a In .Range(.[E4], .[E4].End(xlDown))
- d(a.Value) = "" '取得所有不重複分店
- Next
- F = InputBox("Enter your month")
- For Each ky In d.keys
- .Range("B4").AutoFilter Field:=4, Criteria1:=ky
- If Dir("C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf") <> "" Then Kill "C:\Users\mariasfy\Desktop\" & ky & "_" & F & "201507.pdf" '同名檔案刪除
- .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
- "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
- IgnorePrintAreas:=False, OpenAfterPublish:=False '另存成PDF檔案
- '************************************************************
- SendMail "C:\Users\mariasfy\Desktop\" & ky & "_" & F & ".pdf"
- '************************************************************
- Next
- End With
- End Sub
- Sub SendMail(xFile As String)
- 'VBA 功能表指令: 工具->設定引用項目 新增 -> [Microsoft CDO for Windows 2000 Library]
- '可 Google CreateObject("CDO.Message") 了解
- Dim objEmail As Object
- Set objEmail = CreateObject("CDO.Message") '建立 CDO 物件
- With objEmail
- With .Configuration.Fields
- .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
- .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "msa.hinet.net" '使用 msa.hinet.net 傳送郵件
- .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
- .Update
- End With
- .From = "寄件者@pchome.com" '寄件者（網域必須存在）
- .To = "收件者@gmail.com"
- .Subject = "CreateObjectCDO.Message CDO郵件測試" '郵件主旨
- .HTMLBody = "郵件本文" 'HTML郵件內文
- .AddAttachment xFile '附檔
- .Send
- End With
- End Sub
|
|
發表於 2015-8-2 14:55
| 