返回列表 上一主題 發帖

[發問] 沒有定義這個sub或function

[發問] 沒有定義這個sub或function

各位大大好:

最近在設定Excel表格用VBA Email出去,
以下程式碼原本設定好了,一切正常可用。
因為將不相關的其他模組刪除後,這個模組執行時卻出現「沒有定義這個sub或function」,
然後錯誤訊息停在Sub CDO_TEST_OK()
而RangetoHTML出現反白,
程式碼如下,請各位大大幫幫忙,謝謝~~
  1. Sub CDO_TEST_OK()


  2. Dim objCDO As Object
  3. Dim strCfg As String
  4. Set objCDO = CreateObject("CDO.Message")
  5. strCfg = "http://schemas.microsoft.com/cdo/configuration/"

  6. With objCDO

  7. '.Sender = ""   '

  8. .From = "pxxin@xxx.com.tw"  '寄件者
  9. .To = "pxxin@xxx.com.tw"   '寄給誰

  10. '.Fields("urn:schemas:mailheader:X-Priority") = 1 ' Priority = PriorityUrgent 高優先順序
  11. '.Fields("urn:schemas:mailheader:return-receipt-to") = "" ' 要求讀取回條
  12. ' .Fields("urn:schemas:httpmail:importance") = 2 ' Importance = High
  13. ' .Fields("urn:schemas:httpmail:priority") = 1 ' Priority = PriorityUrgent

  14. .Fields.Update ' 更新欄位
  15. .Subject = "Salary " & Range("A8") & "-" & Range("C8") '主旨


  16. '.TextBody = "ORZ" ' Text 文字格式信件內容
  17. ' 或 HTML 網頁格式信件內容
  18. .HTMLBody = "<HTML>" & _
  19. "<BODY>" & _
  20. "<table border=""1"" width=""100%"">" & _
  21. "<tr><td>I</td><td>am</td><td>Hammer</td><td>!</td></tr>" & _
  22. "<tr><td>Who</td><td>r</td><td>u</td><td>?</td></tr>" & _
  23. "</table>" & _
  24. "</BODY>" & _
  25. "</HTML>"
  26. .HTMLBody = RangetoHTML(Range("A1:J31")) '郵件內文(為EXCEL的表格範圍)請依需求修改

  27. '.AddAttachment "C:\AttFile.zip" ' 附加檔案
  28. '.CC = "副本@yahoo.com.tw" ' 副本
  29. '.BCC = "密件副本@hotmail.com.tw" ' 密件副本
  30. .Configuration(strCfg & "sendusing") = 2 ' Sendusing = SendUsingPort

  31. .Configuration(strCfg & "smtpserver") = "xxxs.com.tw" ' SMTP Server

  32. '.Configuration(strCfg & "smtpserver") = "msa.hinet.net" ' SMTP Server


  33. ' .Configuration(strCfg & "smtpserverport") = 25 ' SMTP Server Port ( 預設即為 25 )
  34. ' SMTP Server 如需登錄 , 則需設定 UserName / Password
  35. ' .Configuration(strCfg & "sendusername") = "UserName" ' Send User Name
  36. ' .Configuration(strCfg & "sendpassword") = "Password" ' Send Password
  37. .Configuration.Fields.Update ' 更新 (欄位) 組態
  38. ' .DSNOptions = 4 ' 回傳信件傳送狀態
  39. ' cdoDSNDefault = 0 , DSN commands are issued.
  40. ' cdoDSNDelay = 8 , Return a DSN if delivery is delayed.
  41. ' cdoDSNFailure = 2 , Return a DSN if delivery fails.
  42. ' cdoDSNNever = 1 , No DSNs are issued.
  43. ' cdoDSNSuccess = 4 , Return a DSN if delivery succeeds.
  44. ' cdoDSNSuccessFailOrDelay = 14 ,Return a DSN if delivery succeeds, fails, or is delayed.
  45. .Send ' 傳送


  46. End With
  47. Set objCDO = Nothing


  48. End Sub
複製代碼

.HTMLBody = RangetoHTML(Range("A1:J31")) 此列錯誤

將 FUNCTION RangetoHTML 貼回來
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 2# ML089

謝謝ML089大大,
程式正常可以執行了,謝謝
    :D

TOP

回復 2# ML089

ML089大大:

剛剛在程式碼最後面加上
Function RangetoHTML(rng As Range)
End Function

程式可正常執行並寄送郵件,
但是郵件內文是空白,不會執行以下程式碼:
.HTMLBody = RangetoHTML(Range("A1:J31"))

謝謝~

TOP

本帖最後由 c_c_lai 於 2016-3-16 12:51 編輯

回復 4# takeshilin88
試試看
  1. Function RangetoHTML(rng As Range)
  2.     Dim rng2 As Range, txt As String
  3.    
  4.     For Each rng2 In rng
  5.         If rng2 <> "" Then
  6.             txt = txt & " " & rng2.Text
  7.         End If
  8.     Next
  9.     RangetoHTML = txt
  10. End Function
複製代碼

TOP

回復 4# takeshilin88
使用CDO寄送郵件不必透過Outlook寄送
你參考這網頁 http://blog.xuite.net/crdotlin/e ... 1%E9%83%B5%E4%BB%B6

如果你有GMAIL帳號,只要小修改一下就使用
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 1# takeshilin88
Function 被你整個刪掉了,你加了一個同名子的空的殼,當然沒用。
google 找的,下面網址有個 RangetoHTML 可能跟你原本的一樣功能,把它貼回去吧。
http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

謝謝各位大大熱心的回答,感激不盡~~

因為必須要使用公司伺服器主機來寄送,
試過用CDO物件寄郵件可以成功。
但是郵件寄出後,有以下幾個問題待解決:
1.請問可以在.Send傳送之前加上.Stop?好讓我可以當下查看準備寄出的郵件資料是否有誤
2.郵件寄出後,寄件備份裡沒有寄件的紀錄,該如何處理?
謝謝

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題