Note: The other languages of the website are Google-translated. Back to English

如何基於Excel中的單元格值自動發送電子郵件?

假設您要基於Excel中指定的單元格值通過Outlook向特定收件人發送電子郵件。 例如,當工作表中單元格D7的值大於200時,將自動創建一封電子郵件。 本文介紹了一種VBA方法供您快速解決此問題。

使用VBA代碼根據單元格值自動發送電子郵件


使用VBA代碼根據單元格值自動發送電子郵件

請執行以下操作以根據Excel中的單元格值發送電子郵件。

1.在工作表中,您需要根據其單元格值(此處為單元格D7)發送電子郵件,右鍵單擊工作表選項卡,然後選擇 查看代碼 從上下文菜單中。 看截圖:

2.在彈出 Microsoft Visual Basic for Applications 窗口,請將以下VBA代碼複製並粘貼到工作表代碼窗口中。

VBA代碼:根據Excel中的單元格值通過Outlook發送電子郵件

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

筆記:

1)。 在 VBA 代碼中, D7值> 200 是您將基於其發送電子郵件的單元格和單元格的值。
2)。 請根據需要更改電子郵件正文 郵件正文 代碼中的一行。
3)。 將電子郵件地址替換為行中的收件人電子郵件地址 .To =“電子郵件地址”.
4)。 並根據需要指定抄送和密送收件人 .CC =“”密件副本=“” 部分。
5)。 最後更改郵件主題 .Subject =“通過單元格值測試發送”.

3。 按 其他 + Q 鍵一起關閉 Microsoft Visual Basic for Applications 窗口。

從現在開始,當您在單元格D7中輸入的值大於200時,將在Outlook中自動創建帶有指定收件人和正文的電子郵件。 您可以點擊 發送 按鈕發送此電子郵件。 看截圖:

筆記:

1.僅當您將Outlook用作電子郵件程序時,VBA代碼才起作用。

2.如果在單元格D7中輸入的數據是文本值,則也會彈出電子郵件窗口。


根據在Excel中創建的郵件列表的字段,通過Outlook輕鬆發送電子郵件:

發電子郵件 的效用 Excel的Kutools 幫助用戶基於Excel中創建的郵件列表通過Outlook發送電子郵件。
立即下載並試用! (30-天免費試用)


相關文章:


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (308)
5中的5評分 · 1評級
網站主持人對此評論進行了最小化
應該如何修改代碼以應用於整個單元格範圍?
網站主持人對此評論進行了最小化
親愛的黛比,
請嘗試下面的 VBA 代碼來解決問題。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
If (Not Intersect(Target, Range("A1:D4")) Is Nothing) And (Target.Value > 200) Then
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
使用 xOutMail
.To = "您的收件人的電子郵件地址"
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
END SUB
網站主持人對此評論進行了最小化
如果單元格中的值被間接更改,我無法讓此代碼提示。 例如,如果我有 Sum 方程自動更改此值。 當等式運行並且值超過設置值以提示電子郵件時,它不會這樣做,除非我自己實際更改了數字。 即使間接更改,有沒有辦法使電子郵件提示?
網站主持人對此評論進行了最小化
親愛的喬丹,
以下 VBA 代碼可以幫助您解決問題。 請不要忘記將代碼中的“電子郵件地址”替換為收件人的電子郵件地址。 謝謝你。

Private Sub Worksheet_Change(ByVal Target As Range)
將 xRgPre 調暗為範圍
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
設置xRg = Range(“ D7”)
設置 xRgPre = xRg.Precedents
如果 xRg.Value > 200 那麼
如果 Target.Address = xRg.Address 那麼
致電 Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) 然後
致電 Mail_small_Text_Outlook
如果結束
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
使用 xOutMail
.To =“電子郵件地址”
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
END SUB
網站主持人對此評論進行了最小化
我已經修改了建議的代碼以嘗試使其適用於我的應用程序。
更改了 xRg = Range("C2:C40") 和如果 xRg.Value = -1。

我遇到的問題是任何時候任何單元格發生變化,只要我範圍內的一個單元格是 = -1,它就會調用 Mail_small_Text_Outlook。
我試圖僅在我的範圍內的任何單元格間接更改為-1 時調用。
我還想知道是否以及如何使其滿足兩個標準。
像檢查範圍 A 和範圍 B 以及它們是否符合標準調用函數。

在此先感謝您的幫助。 我對這一切都很陌生,但是通過這個線程閱讀讓我有大約 90% 的情況。


Private Sub Worksheet_Change(ByVal Target As Range)
將 xRgPre 調暗為範圍
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
設置 xRg = Range("C2:C40")
設置 xRgPre = xRg.Precedents
如果 xRg.Value = -1 那麼
如果 Target.Address = xRg.Address 那麼
致電 Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) 然後
致電 Mail_small_Text_Outlook
如果結束
如果結束
END SUB
網站主持人對此評論進行了最小化
我使用了這段代碼,唯一的改變是我將它應用於整個列 [Set xRg = Range("D4:D13")]。 現在,無論 D 列中的閥門是否低於目標值,只要進行計算,就會觸發該事件。 知道這是為什麼嗎?


將 Xrg 調暗為範圍
Private Sub Worksheet_Change(ByVal Target As Range)
將 xRgPre 調暗為範圍
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
設置 Xrg = Range("D4:D13")
設置 xRgPre = Xrg.Precedents
如果 Xrg.Value < 1200 那麼
如果 Target.Address = Xrg.Address 則
致電 Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) 然後
致電 Mail_small_Text_Outlook
如果結束
如果結束
END SUB

子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "嗨" & vbNewLine & _
“測試vba”_
& vbNewLine & _
“2號線。”
在錯誤恢復下一頁
使用 xOutMail
.To = ""
.CC =“”
.BCC =“”
.Subject = "自動電子郵件測試"
.Body = xMailBody
。顯示
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無

END SUB


謝謝。
網站主持人對此評論進行了最小化
你好

我遇到了麻煩,因為必須一次又一次地添加電子郵件收件人。 請指導是否可以將電子郵件收件人列表添加到此功能,以便該功能將從提供的電子郵件地址列表或列表上傳中選擇電子郵件地址,然後該功能將已編寫的電子郵件發送給所需的收件人。
網站主持人對此評論進行了最小化
親愛的亨利,
以下 VBA 代碼可以幫助您解決問題。 請將 VBA 腳本放入您的工作表模塊。 當指定單元格中的值滿足條件時,將彈出 Kutools for Excel 對話框,請選擇包含收件人電子郵件地址的單元格,然後單擊 OK 按鈕。 然後打開指定收件人的電子郵件。 請根據需要發送它們。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
設置xRg = Range(“ D7”)
如果 xRg = Target And Target.Value > 200 那麼
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
將 xRgMsg 調暗為範圍
將 xCell 調暗為範圍
Set xRgMsg = Application.InputBox("請選擇地址單元格:", "Kutools for Excel", , , , , , 8)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
對於 xRgMsg 中的每個 xCell
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
使用 xOutMail
.To = xCell.Value
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
xOutApp = 沒有
xOutMail = 沒有
下一頁
在錯誤轉到0
END SUB
網站主持人對此評論進行了最小化
是否會自動發送郵件,無需任何人工中斷
網站主持人對此評論進行了最小化
親愛的梵天,
如果您想直接發送郵件而不顯示,請將上述 VBA 代碼中的“.Display”行替換為“.Send”。
網站主持人對此評論進行了最小化
嗨,我放了相同的腳本,但它不起作用,請在第一部分幫助我

將 xRg 調暗為範圍

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
設置xRg = Range(“ D7”)
如果 xRg = Target And Target.Value = 200 那麼
致電 Mail_small_Text_Outlook
如果結束

END SUB
網站主持人對此評論進行了最小化
親愛的羅勒,
運行代碼時是否有任何警告?
網站主持人對此評論進行了最小化
您好,您將如何修改此代碼以檢查一組單元格是否具有字符串“不匹配”並發送電子郵件(如果有)。
網站主持人對此評論進行了最小化
親愛的何塞,
請嘗試以下 VBA 代碼。 運行代碼時,會彈出一個對話框,請選擇要檢查字符串的範圍,然後單擊確定按鈕。 如果字符串不存在,您將得到一個提示對話框。 如果該字符串存在於該範圍內,將顯示具有指定收件人、主題和正文的電子郵件。

子發送電子郵件()
暗淡我只要
昏暗J只要
將 xRg 調暗為範圍
暗淡 xArr
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
將 xFlag 調暗為布爾值
在錯誤恢復下一頁
Set xRg = Application.InputBox("請選擇範圍", "Kutools for Excel", Selection.Address, , , , , 8)
如果 xRg 什麼都不是,則退出 Sub
xArr = xRg.值
xFlag = 假
對於 I = 1 到 UBound(xArr)
對於 J = 1 到 UBound(xArr, 2)
如果 xArr(I, J) = "不匹配" 那麼
xFlag = 真
如果結束
下一頁
下一頁
如果 xFlag 則
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
使用 xOutMail
.To = "電子郵件地址"
.CC =“”
.BCC =“”
.Subject = "匹配"
.Body = xMailBody
.Display '或使用 .Send
結束
其他
MsgBox "找不到匹配的值", vbInformation, "KuTools for Excel"
如果結束
END SUB
網站主持人對此評論進行了最小化
我如何更改此代碼以將學生成績發送給父母。 如果 A 列是成績,B 列是父電子郵件。 我想為每個學生填寫一封電子郵件,並以 F 作為成績。
網站主持人對此評論進行了最小化
親愛的弗蘭克,
下面的 VBA 代碼可以幫助您解決問題。 謝謝你。

子 Mail_small_Text_Outlook()
將 xRg 調暗為範圍
暗淡我只要
將 xRows 變暗
將 xVal 調暗為字符串
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
在錯誤恢復下一頁
Set xRg = Application.InputBox("請選擇成績欄和郵箱欄(兩欄)", "Kutools for Excel", Selection.Address, , , , , 8)
如果 xRg 什麼都不是,則退出 Sub
xRows = xRg.Rows.Count
設置 xRg = xRg(2)
對於 I = 1 到 xRows
xVal = xRg.Offset(I, -1).Text
如果 xVal = "F" 那麼
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是你孩子的成績” & xRg.Offset(I, -1).Text
使用 xOutMail
.to = xRg.Offset(I, 0).文本
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
我的 excel 文件中已經有一個電子郵件地址列表,如果他的單元格 D7 >200,我如何修改代碼以自動選擇該人的電子郵件地址?
網站主持人對此評論進行了最小化
美好的一天,
以下 VBA 代碼可以幫助您解決問題。 請將 VBA 腳本放入您的工作表模塊。 當指定單元格中的值滿足條件時,將彈出 Kutools for Excel 對話框,請選擇包含收件人電子郵件地址的單元格,然後單擊 OK 按鈕。 然後打開指定收件人的電子郵件。 請根據需要發送它們。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
設置xRg = Range(“ D7”)
如果 xRg = Target And Target.Value > 200 那麼
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
將 xRgMsg 調暗為範圍
將 xCell 調暗為範圍
Set xRgMsg = Application.InputBox("請選擇地址單元格:", "Kutools for Excel", , , , , , 8)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
對於 xRgMsg 中的每個 xCell
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
使用 xOutMail
.To = xCell.Value
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
xOutApp = 沒有
xOutMail = 沒有
下一頁
在錯誤轉到0
END SUB
網站主持人對此評論進行了最小化
我無法通過 Outlook 發送郵件。 我收到錯誤消息“程序正在嘗試代表您發送電子郵件。如果發生意外,請拒絕並驗證您的防病毒軟件是最新的”
請幫忙,因為我無法自動化它。
網站主持人對此評論進行了最小化
對不起,馬揚克,
該代碼在我的情況下運行良好。 似乎在您的 Outlook 中配置了有關“代表發送”功能的內容。 請檢查一下。
網站主持人對此評論進行了最小化
您好,如果我嘗試向經理髮送一封電子郵件,該經理有一個每月一次數量 > 200 的水果列表(基於您的示例)或即將到期(基於日期),我將使用什麼代碼
網站主持人對此評論進行了最小化
美好的一天
可能是這篇文章中的方法“如果Excel中的截止日期已經滿足,如何發送電子郵件?” 可以幫你。
請點擊此鏈接: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
網站主持人對此評論進行了最小化
如何編輯代碼以根據單元格中的日期發送電子郵件。 例如,我需要每 15 個月審查一次文件,並且我想在 12 個月後向一個電子郵件地址發送一封電子郵件,說明該文件需要審查。 我現在可以通過將 .Display 更改為 .Send 來自動發送電子郵件,並且它的工作原理與所寫的一樣好,但是我需要更改什麼才能使用日期函數而不是整數?
網站主持人對此評論進行了最小化
如何將多個範圍添加到“Set xRg = Range("D7")”。 我想編輯它並添加 Range("D7:F7")。 但是,我收到運行時錯誤 13,類型不匹配的錯誤,它帶我進入 If xRg = Target And Target.Value > 2 Then。


我該如何解決這個問題?
網站主持人對此評論進行了最小化
美好的一天,
請嘗試下面的 VBA 代碼來解決問題。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
If (Not Intersect(Target, Range("D7:F7")) Is Nothing) And (Target.Value > 200) Then
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
使用 xOutMail
.To = "您的收件人的電子郵件地址"
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
END SUB
網站主持人對此評論進行了最小化
工作得很好..謝謝..:):)
網站主持人對此評論進行了最小化
它對我不起作用,因為 D7 中的值是公式的結果。 如果單元格 D7 包含一個公式,例如 D7 =2*120,該怎麼辦? 它仍然符合條件,但沒有發生任何事情。 請幫忙
網站主持人對此評論進行了最小化
如何停止代碼運行即不滿足條件時不提示電子郵件?

即使 D7 < 200,我仍然會收到電子郵件提示。
網站主持人對此評論進行了最小化
美好的一天,
代碼在帖子中更新,問題已解決。 感謝您的評論。
網站主持人對此評論進行了最小化
Hi

非常感謝您發布此 VBA 代碼和說明。 當我找到它時,我覺得我中了樂透。 但是我被困在一些事情上,所以我希望你能提供幫助(我是 VBA 的新手,只有非常基本的理解)。

如果滿足條件,我已經復制了代碼並更改了單元格和單元格值以從範圍中選擇。 我已經嘗試並測試過了,它可以工作,並且我收到了一封基於標準發送給 Outlook 的電子郵件。

1) 但是,當我打開 Excel 工作表時,我似乎無法弄清楚如何讓 VBA 代碼自動運行,而不必單擊 VBA 應用程序並選擇運行。 您能否告知是否有額外的提示可以輸入上面的 VBA 代碼來執行此操作,或者是否必須單獨完成。

2)如果某個項目的截止日期是“是”,還有一種方法可以讓 VBA 代碼向某人發送郵件,如下例所示。
電子郵件隱藏欄
姓名

程序
程序 1 截止日期 是
程序編號2 截止日期無

我會在電子表格中有很多人(在一行中水平穿過)並且可以為各種過期程序突出顯示“是”(在 A 列中垂直列出。有沒有辦法創建一個運行類似這樣的 VBA 代碼 -如果“人員 1”為“是”,則向“人員 1”發送電子郵件,並附上“程序編號 #”(或數字)和截止日期。能夠在電子郵件中列出所有程序及其後續截止日期。

我不介意我是否必須為每個人設置一個單獨的 VBA 代碼,只要它發送一封包含該人所有逾期文件和到期日期的郵件即可。

希望你能提供幫助
網站主持人對此評論進行了最小化
親愛的安,
請嘗試以下 VBA 代碼。 感謝您的評論。

子 Mail_small_Text_Outlook()
將 xRg 調暗為範圍
將 xCell 調暗為範圍
暗淡我只要
將 xRows 變暗
將 xCols 調暗
將 xVal 調暗為字符串
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
在錯誤恢復下一頁
Set xRg = Application.InputBox("選擇包含您將發送電子郵件的單元格值的範圍:", "Kutools for Excel", Selection.Address, , , , , 8)
如果 xRg 什麼都不是,則退出 Sub
xRows = xRg.Rows.Count
xCols = xRg.Columns.Count
對於 I = 1 到 xRows
設置 xCell = xRg(I, xCols)
如果 xCell.Value = "Yes" 那麼
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是你的信息:” & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
使用 xOutMail
.To = xCell.Offset(0, -4).Text
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
水晶,

這將替換以下代碼:

子電子郵件()

將 xRg 調暗為範圍

將 xRgEach 調暗為範圍

暗淡 xEmail_Subject、xEmail_Send_Form 等。
網站主持人對此評論進行了最小化
我們到底在哪裡插入這段代碼?
網站主持人對此評論進行了最小化
美好的一天,
您需要將代碼放入工作表的代碼窗口中。
打開 Microsoft Visual Basic for Applications 窗口,雙擊左側窗格中的工作表名稱以打開代碼編輯器。
網站主持人對此評論進行了最小化
你好,


我目前在編碼方面遇到了一些麻煩(對此很陌生-可能咬得比我能咀嚼的還多)


我目前有一個電子表格,包含以下內容


我目前需要一個可以使用以下數據的代碼:


1)地址和問題(通過((在單元格D2)中合併的1個“一般”單元格)“==CONCAT(B1,”“C1,)”
B1 中的地址總是相同的(或多或少)
而 C1 將始終根據屬性的故障而變化。


2) 一封由同一電子郵件地址發送的電子郵件,(我可以使用 $E$1 還是必須使用 E1 - E1 。例如)或者我可以在代碼行中輸入“TheEmailAdress@.co.uk”


3) 以與第 1 點類似的方式填充電子郵件正文) ...... ((在單元格 F1)) " =CONCAT(G1," ",H1)
這些將不斷變化,因為它們代表公司(G1)以及他們正在做什麼,修復,引用等(H1)

4)發送電子郵件的觸發器,我將是數字 7 ,表格每天更新(一周中的 7 天)
因此,我需要觸發器在第 7 天發送電子郵件,但在第 8 天、第 9 天、第 10 天等時不需要經常發送電子郵件。 而不是在 1-6 之前,這將在 A4 中:A 100+(因為我們正在不斷擴展


4)我使用了其他用戶的小片段,他們提到使用觸發器列表來發送電子郵件,但不確定它是否 100% 正確,但我需要它來掃描所有 Collum A... .A4:A100
如果有 47 個單元格僅包含“7”,則將發送 47 封電子郵件


非常感謝您的閱讀,希望您能提供幫助:)
網站主持人對此評論進行了最小化
親愛的馬丁,
抱歉幫不上忙。
您可以在我們的論壇中發布您的問題: https://www.extendoffice.com/forum.html 從我們的技術人員那裡獲得更多的 Excel 支持。
感謝您的評論。

最好的問候,
Crystal 水晶
網站主持人對此評論進行了最小化
嗨,


如果我想根據添加到 L 列的“完成”一詞來發送電子郵件怎麼辦?
網站主持人對此評論進行了最小化
親愛的傑西,
以下 VBA 代碼可以幫助您解決問題。 感謝您的評論。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
If (Not Intersect(Target, Range("L:L")) Is Nothing) And (Target.Value = "completed") Then
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
使用 xOutMail
.To = "您的收件人的電子郵件地址"
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
END SUB
網站主持人對此評論進行了最小化
嗨,
我希望 Outlook 僅在我粘貼到範圍(“D7:F7”)中的數據至少有 1 個零或空白時才彈出。
我已經刪除了“If Target.Cells.Count > 1 Then Exit Sub”行,現在當我將任何一組值粘貼到單元格 D7:F7 中時,Outlook 總是會啟動。

幫助。
網站主持人對此評論進行了最小化
親愛的簡,
以下腳本可以幫助您解決問題。 感謝您的評論。

Private Sub Worksheet_Change(ByVal Target As Range)
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
在錯誤恢復下一頁
If Target.Address = Range("D7:F7").Address Then
使用 Application.WorksheetFunction
如果 .CountIf(Target, "") > 0 或 .CountIf(Target, 0) > 0 那麼
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
使用 xOutMail
.To =“電子郵件地址”
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body =“你好”
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
如果結束
結束
如果結束
END SUB
網站主持人對此評論進行了最小化
因此,我使用您的編輯來包含單元格範圍,但是(如果我們使用工作表示例)我想知道如何將水果的類型、日期和數量從工作表添加到 HTML 電子郵件中,如果它們符合標準生成一封電子郵件。 所以它會說

“你好呀,”

單元格中的水果名稱“需要延期交貨,因為截至訂單日期:”單元格中的訂單日期“我們有這個數量:”單元格中的數量。
網站主持人對此評論進行了最小化
嗨諾埃米,
請試試這個 VBA 腳本。

Private Sub Worksheet_Change(ByVal Target As Range)
將 xRg 調暗為範圍
將 I、J、K 變暗
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
在錯誤恢復下一頁
If Target.Address = Range("D7").Address Then
使用 Application.WorksheetFunction
如果 IsNumeric(Target.Value) 和 Target.Value > 200 則
Set xRg = Application.InputBox("請選擇您將在郵件正文中顯示的單元格範圍:", "KuTools for Excel", Selection.Address, , , , , 8)
如果 xRg 什麼都不是,則退出 Sub
對於 I = 1 到 xRg.Rows.Count
對於 J = 1 到 xRg.Rows(I).Columns.Count
對於 K = 1 到 xRg.Rows(I).Columns(J).Count
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
下一頁
下一頁
xMailBody = xMailBody & vbNewLine
下一頁
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
使用 xOutMail
.To =“電子郵件地址”
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = "你好" & vbNewLine & xMailBody
.Display '或使用 .Send
結束
在錯誤轉到0
設置 xOutMail = 無
設置 xOutApp = 無
如果結束
結束
如果結束
END SUB
網站主持人對此評論進行了最小化
嗨水晶
感謝您的代碼,如果可能,請發送代碼以獲取以下詳細信息

如果我們有 8 到 9 列使用不同類型的過期日期,如護照過期日期、駕駛執照過期日期、車輛登記過期日期、門牌過期日期等,並且郵件警報必須僅發送給 5 個給定的人。

就像我們的日期表有 300 多名員工一樣,過期和到期日期在 15 天內為紅色,並且應發送電子郵件警報。

請做需要的事

在此先感謝
網站主持人對此評論進行了最小化
你好,
我們發布了一篇文章“如果 Excel 中的截止日期已到,如何發送電子郵件?”
你可以看看這篇文章有沒有答案。 請點擊此鏈接打開文章: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
謝謝。
網站主持人對此評論進行了最小化
您好-如果我想從列表中發送電子郵件,而不是將實際的電子郵件地址放入代碼中,這可能嗎? 謝謝
網站主持人對此評論進行了最小化
你好,
請嘗試下面的 VBA 代碼,當指定的單元格滿足條件時,將彈出一個對話框,請選擇包含您將發送電子郵件的電子郵件地址的單元格。 希望它可以提供幫助。 謝謝你。

Private Sub Worksheet_Change(ByVal Target As Range)
如果 Target.Cells.Count > 1 然後退出 Sub
設置xRg = Range(“ D7”)
如果 xRg = Target And Target.Value > 200 那麼
致電 Mail_small_Text_Outlook
如果結束
END SUB
子 Mail_small_Text_Outlook()
將 xOutApp 調暗為對象
將 xOutMail 調暗為對象
將 xMailBody 調暗為字符串
將 xRgMsg 調暗為範圍
將 xCell 調暗為範圍
Set xRgMsg = Application.InputBox("請選擇地址單元格:", "Kutools for Excel", , , , , , 8)
xMailBody = "你好" & vbNewLine & vbNewLine & _
“這是第 1 行” & vbNewLine & _
“這是第 2 行”
在錯誤恢復下一頁
對於 xRgMsg 中的每個 xCell
設置 xOutApp = CreateObject("Outlook.Application")
設置 xOutMail = xOutApp.CreateItem(0)
使用 xOutMail
.To = xCell.Value
.CC =“”
.BCC =“”
.Subject =“通過單元格值測試發送”
.Body = xMailBody
.Display '或使用 .Send
結束
xOutApp = 沒有
xOutMail = 沒有
下一頁
在錯誤轉到0
END SUB
這裡還沒有評論
載入更多
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護