- 帖子
- 62
- 主題
- 13
- 精華
- 0
- 積分
- 109
- 點名
- 0
- 作業系統
- Win 10家用版
- 軟體版本
- Office 2013
- 閱讀權限
- 20
- 性別
- 女
- 來自
- 新北
- 註冊時間
- 2016-1-27
- 最後登錄
- 2024-8-12
|
各位大大好:
最近在設定Excel表格用VBA Email出去,
以下程式碼原本設定好了,一切正常可用。
因為將不相關的其他模組刪除後,這個模組執行時卻出現「沒有定義這個sub或function」,
然後錯誤訊息停在Sub CDO_TEST_OK()
而RangetoHTML出現反白,
程式碼如下,請各位大大幫幫忙,謝謝~~- Sub CDO_TEST_OK()
- Dim objCDO As Object
- Dim strCfg As String
- Set objCDO = CreateObject("CDO.Message")
- strCfg = "http://schemas.microsoft.com/cdo/configuration/"
- With objCDO
- '.Sender = "" '
- .From = "[email protected]" '寄件者
- .To = "[email protected]" '寄給誰
- '.Fields("urn:schemas:mailheader:X-Priority") = 1 ' Priority = PriorityUrgent 高優先順序
- '.Fields("urn:schemas:mailheader:return-receipt-to") = "" ' 要求讀取回條
- ' .Fields("urn:schemas:httpmail:importance") = 2 ' Importance = High
- ' .Fields("urn:schemas:httpmail:priority") = 1 ' Priority = PriorityUrgent
- .Fields.Update ' 更新欄位
- .Subject = "Salary " & Range("A8") & "-" & Range("C8") '主旨
- '.TextBody = "ORZ" ' Text 文字格式信件內容
- ' 或 HTML 網頁格式信件內容
- .HTMLBody = "<HTML>" & _
- "<BODY>" & _
- "<table border=""1"" width=""100%"">" & _
- "<tr><td>I</td><td>am</td><td>Hammer</td><td>!</td></tr>" & _
- "<tr><td>Who</td><td>r</td><td>u</td><td>?</td></tr>" & _
- "</table>" & _
- "</BODY>" & _
- "</HTML>"
- .HTMLBody = RangetoHTML(Range("A1:J31")) '郵件內文(為EXCEL的表格範圍)請依需求修改
- '.AddAttachment "C:\AttFile.zip" ' 附加檔案
- '.CC = "副本@yahoo.com.tw" ' 副本
- '.BCC = "密件副本@hotmail.com.tw" ' 密件副本
- .Configuration(strCfg & "sendusing") = 2 ' Sendusing = SendUsingPort
- .Configuration(strCfg & "smtpserver") = "xxxs.com.tw" ' SMTP Server
- '.Configuration(strCfg & "smtpserver") = "msa.hinet.net" ' SMTP Server
- ' .Configuration(strCfg & "smtpserverport") = 25 ' SMTP Server Port ( 預設即為 25 )
- ' SMTP Server 如需登錄 , 則需設定 UserName / Password
- ' .Configuration(strCfg & "sendusername") = "UserName" ' Send User Name
- ' .Configuration(strCfg & "sendpassword") = "Password" ' Send Password
- .Configuration.Fields.Update ' 更新 (欄位) 組態
- ' .DSNOptions = 4 ' 回傳信件傳送狀態
- ' cdoDSNDefault = 0 , DSN commands are issued.
- ' cdoDSNDelay = 8 , Return a DSN if delivery is delayed.
- ' cdoDSNFailure = 2 , Return a DSN if delivery fails.
- ' cdoDSNNever = 1 , No DSNs are issued.
- ' cdoDSNSuccess = 4 , Return a DSN if delivery succeeds.
- ' cdoDSNSuccessFailOrDelay = 14 ,Return a DSN if delivery succeeds, fails, or is delayed.
- .Send ' 傳送
- End With
- Set objCDO = Nothing
- End Sub
複製代碼 |
|