返回列表 上一主題 發帖

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

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
62 
主題
13 
精華
0 
積分
109 
點名
0  
作業系統
Win 10家用版 
軟體版本
Office 2013 
閱讀權限
20 
性別
女 
來自
新北 
註冊時間
2016-1-27 
最後登錄
2024-8-12 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
2#
發表於 2016-3-15 20:42 | 只看該作者
.HTMLBody = RangetoHTML(Range("A1:J31")) 此列錯誤

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

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
62 
主題
13 
精華
0 
積分
109 
點名
0  
作業系統
Win 10家用版 
軟體版本
Office 2013 
閱讀權限
20 
性別
女 
來自
新北 
註冊時間
2016-1-27 
最後登錄
2024-8-12 
3#
發表於 2016-3-16 08:59 | 只看該作者
回復 2# ML089

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

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
62 
主題
13 
精華
0 
積分
109 
點名
0  
作業系統
Win 10家用版 
軟體版本
Office 2013 
閱讀權限
20 
性別
女 
來自
新北 
註冊時間
2016-1-27 
最後登錄
2024-8-12 
4#
發表於 2016-3-16 09:08 | 只看該作者
回復 2# ML089

ML089大大：

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

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

謝謝~

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
5#
發表於 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
複製代碼

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
6#
發表於 2016-3-16 13:24 | 只看該作者
回復 4# takeshilin88
使用CDO寄送郵件不必透過Outlook寄送
你參考這網頁 http://blog.xuite.net/crdotlin/e ... 1%E9%83%B5%E4%BB%B6

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

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
7#
發表於 2016-3-16 16:21 | 只看該作者
回復 1# takeshilin88
Function 被你整個刪掉了，你加了一個同名子的空的殼，當然沒用。
google 找的，下面網址有個 RangetoHTML 可能跟你原本的一樣功能，把它貼回去吧。
http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

takeshilin88
　暱稱: 鹹蛋

中學生Rank: 2

帖子
62 
主題
13 
精華
0 
積分
109 
點名
0  
作業系統
Win 10家用版 
軟體版本
Office 2013 
閱讀權限
20 
性別
女 
來自
新北 
註冊時間
2016-1-27 
最後登錄
2024-8-12 
8#
發表於 2016-3-16 16:49 | 只看該作者
謝謝各位大大熱心的回答，感激不盡~~

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

TOP

        靜思自在 : 忘功不忘過，忘怨不忘恩。
返回列表 上一主題