Board logo

標題: [發問] 沒有定義這個sub或function [打印本頁]
作者: takeshilin88    時間: 2016-3-15 19:08     標題: 沒有定義這個sub或function

各位大大好：

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


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

  9. With objCDO

  11. '.Sender = ""   '

  13. .From = "[email protected]"  '寄件者
  14. .To = "[email protected]"   '寄給誰

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

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


  25. '.TextBody = "ORZ" ' Text 文字格式信件內容
  26. ' 或 HTML 網頁格式信件內容
  27. .HTMLBody = "<HTML>" & _
  28. "<BODY>" & _
  29. "<table border=""1"" width=""100%"">" & _
  30. "<tr><td>I</td><td>am</td><td>Hammer</td><td>!</td></tr>" & _
  31. "<tr><td>Who</td><td>r</td><td>u</td><td>?</td></tr>" & _
  32. "</table>" & _
  33. "</BODY>" & _
  34. "</HTML>"
  35. .HTMLBody = RangetoHTML(Range("A1:J31")) '郵件內文(為EXCEL的表格範圍)請依需求修改

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

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

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


  47. ' .Configuration(strCfg & "smtpserverport") = 25 ' SMTP Server Port ( 預設即為 25 )
  48. ' SMTP Server 如需登錄 , 則需設定 UserName / Password
  49. ' .Configuration(strCfg & "sendusername") = "UserName" ' Send User Name
  50. ' .Configuration(strCfg & "sendpassword") = "Password" ' Send Password
  51. .Configuration.Fields.Update ' 更新 (欄位) 組態
  52. ' .DSNOptions = 4 ' 回傳信件傳送狀態
  53. ' cdoDSNDefault = 0 , DSN commands are issued.
  54. ' cdoDSNDelay = 8 , Return a DSN if delivery is delayed.
  55. ' cdoDSNFailure = 2 , Return a DSN if delivery fails.
  56. ' cdoDSNNever = 1 , No DSNs are issued.
  57. ' cdoDSNSuccess = 4 , Return a DSN if delivery succeeds.
  58. ' cdoDSNSuccessFailOrDelay = 14 ,Return a DSN if delivery succeeds, fails, or is delayed.
  59. .Send ' 傳送


  62. End With
  63. Set objCDO = Nothing


  66. End Sub
複製代碼
作者: ML089    時間: 2016-3-15 20:42

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

將 FUNCTION RangetoHTML 貼回來
作者: takeshilin88    時間: 2016-3-16 08:59

回復 2# ML089

謝謝ML089大大，
程式正常可以執行了，謝謝
    :D
作者: takeshilin88    時間: 2016-3-16 09:08

回復 2# ML089

ML089大大：

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

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

謝謝~
作者: c_c_lai    時間: 2016-3-16 12:45

本帖最後由 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
複製代碼
作者: ML089    時間: 2016-3-16 13:24

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

如果你有GMAIL帳號，只要小修改一下就使用
作者: stillfish00    時間: 2016-3-16 16:21

回復 1# takeshilin88
Function 被你整個刪掉了，你加了一個同名子的空的殼，當然沒用。
google 找的，下面網址有個 RangetoHTML 可能跟你原本的一樣功能，把它貼回去吧。
http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
作者: takeshilin88    時間: 2016-3-16 16:49

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

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)