Vba 基于范围内的值触发操作_Vba_Excel

Vba 基于范围内的值触发操作

vba excel

Vba 基于范围内的值触发操作,vba,excel,Vba,Excel,我有一份工作表，其中包含： A列中的项目编号项目说明列B 项目经理电子邮件地址Col C 日期字段列D和E 已发送状态列F 发送日期列G 我想发送一封电子邮件，一旦截止日期已经达到，在电子表格的适用行的细节我让它运行，但它是特定于细胞“A2”和“C2” 我试图修改代码，以反映“A2”引用的范围，但收到一条“编译错误语法错误”消息，该消息指向这一行，该行以红色突出显示： sSendTo = Sheet1.Range.Columns(C) & lLastRow).Value 我的代码

我有一份工作表，其中包含：
A列中的项目编号
项目说明列B
项目经理电子邮件地址Col C
日期字段列D和E
已发送状态列F
发送日期列G

我想发送一封电子邮件，一旦截止日期已经达到，在电子表格的适用行的细节

我让它运行，但它是特定于细胞“A2”和“C2”

我试图修改代码，以反映“A2”引用的范围，但收到一条“编译错误语法错误”消息，该消息指向这一行，该行以红色突出显示：

sSendTo = Sheet1.Range.Columns(C) & lLastRow).Value

我的代码是：

Sub Jose_SendEmailDueDateReached()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim lLastRow As Long
    Dim lRow As Long
    Dim sSendTo As String
    Dim sSendCC As String
    Dim sSendBCC As String
    Dim sSubject As String
    Dim sTemp As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    ' Change the following as needed
    sSendTo = Sheet1.Range.Columns(C) & lLastRow).Value
    sSendCC = "Test@123.com"
    sSendBCC = ""
    sSubject = Range("A2").Value & " Progress Photos Due"

    lLastRow = Cells(Rows.Count, 3).End(xlDown).Row
    For lRow = 2 To lLastRow
        If Cells(lRow, 6) <> "Sent" Then
            If Cells(lRow, 5) <= Date Then
                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .To = sSendTo
                    If sSendCC > "" Then .CC = sSendCC
                    If sSendBCC > "" Then .BCC = sSendBCC

                    .Subject = sSubject

                    sTemp = "Hello," & vbCrLf & vbCrLf
                    sTemp = sTemp & "The due date has been reached "
                    sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
                    ' Assumes project name is in column B
                    sTemp = sTemp & "    " & Cells(lRow, 2) & vbCrLf & vbCrLf
                    sTemp = sTemp & "Please take the appropriate"
                    sTemp = sTemp & " action." & vbCrLf & vbCrLf
                    sTemp = sTemp & "Please forward photos to Test@greenscreen.com.    " & vbCrLf & vbCrLf & vbCrLf & vbCrLf
                    sTemp = sTemp & "Thank you."

                    .Body = sTemp
                    ' Change the following to .Send if you want to
                    ' send the message without reviewing first
                    .Display
                End With
                Set OutMail = Nothing

                Cells(lRow, 6) = "Sent"
                Cells(lRow, 7) = "E-mail sent on: " & Now()
            End If
        End If
    Next lRow
    Set OutApp = Nothing

    MsgBox ("Clear Stamp")
    Range("F2").ClearContents
    Range("G2").ClearContents
    MsgBox ("Stamp Cleared")

End Sub

Sub Jose_sendmailduedatereach（）
Dim OutApp作为对象
将邮件变暗为对象
昏暗的灯塔一样长
暗淡的光线和长的一样
将sSendTo设置为字符串
Dim sSendCC作为字符串
Dim sSendBCC作为字符串
作为字符串的Dim SSObject
作为字符串的Dim sTemp
Set-OutApp=CreateObject（“Outlook.Application”）
OutApp.Session.Logon
'根据需要更改以下内容
sSendTo=Sheet1.Range.Columns（C）和lLastRow.Value
sSendCC=”Test@123.com"
sSendBCC=“”
SSObject=范围（“A2”）。值和“进度照片到期”
lLastRow=单元格（Rows.Count，3）.结束（xlDown）.行
对于lRow=2至lLastRow
如果单元格（lRow，6）“已发送”，则
如果单元格（lRow，5）“，则.CC=sSendCC
如果sSendBCC>“”则.BCC=sSendBCC
.Subject=ssobject
sTemp=“你好，”&vbCrLf&vbCrLf
sTemp=sTemp&“到期日已到”
sTemp=sTemp&“对于此项目：”&vbCrLf&vbCrLf
'假定项目名称在B列中
sTemp=sTemp&&&Cells（lRow，2）&vbCrLf&vbCrLf
sTemp=sTemp&“请选择适当的”
sTemp=sTemp&“动作”&vbCrLf&vbCrLf
sTemp=sTemp&“请将照片转发给Test@greenscreen.com.“&vbCrLf&vbCrLf&vbCrLf&vbCrLf&vbCrLf
sTemp=sTemp&“谢谢你。”
.Body=sTemp
'将以下内容更改为。如果需要，请发送
'在不先查看的情况下发送消息
.展示
以
发送邮件=无
单元格（lRow，6）=“已发送”
单元格（lRow，7）=“电子邮件发送日期：”&Now（）
如果结束
如果结束
下一条路
设置应用程序=无
MsgBox（“透明印章”）
范围（“F2”）.ClearContents
范围（“G2”）。ClearContents
MsgBox（“已清除印章”）
端接头

我是VBA新手。

试试这个：

Sub Jose_SendEmailDueDateReached()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim lLastRow As Long
    Dim lRow As Long
    Dim sSendTo As String
    Dim sSendCC As String
    Dim sSendBCC As String
    Dim sSubject As String
    Dim sTemp As String
    Dim vDB As Variant
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    vDB = Sheet1.Range("a1").CurrentRegion

    For lRow = 2 To UBound(vDB, 1)

        If vDB(irow, 6) <> "Sent" Then
            If vDB(lRow, 5) <= Date Then
                Set OutMail = OutApp.CreateItem(0)
                sSendTo = vDB(i, 4)
                sSubject = vDB(i, 1) & " Progress Photos Due"

                On Error Resume Next
                With OutMail
                    .To = sSendTo
                    'If sSendCC > "" Then .CC = sSendCC
                    'If sSendBCC > "" Then .BCC = sSendBCC
                    .Subject = sSubject

                    sTemp = "Hello," & vbCrLf & vbCrLf
                    sTemp = sTemp & "The due date has been reached "
                    sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
                    ' Assumes project name is in column B
                    sTemp = sTemp & "    " & Cells(lRow, 2) & vbCrLf & vbCrLf
                    sTemp = sTemp & "Please take the appropriate"
                    sTemp = sTemp & " action." & vbCrLf & vbCrLf
                    sTemp = sTemp & "Please forward photos to BAS.HSGReporting@hpw.qld.gov.au.  " & vbCrLf & vbCrLf & vbCrLf & vbCrLf
                    sTemp = sTemp & "Thank you."

                    .Body = sTemp
                    ' Change the following to .Send if you want to
                    ' send the message without reviewing first
                    .Save
                    .Send
                    .Display
                End With
                Set OutMail = Nothing

                vDB(lRow, 6) = "Sent"
                vDB(lRow, 7) = "E-mail sent on: " & Now()
            End If
        End If
    Next lRow
    Set OutApp = Nothing
    Sheet1.Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

End Sub

Sub Jose_sendmailduedatereach（）
Dim OutApp作为对象
将邮件变暗为对象
昏暗的灯塔一样长
暗淡的光线和长的一样
将sSendTo设置为字符串
Dim sSendCC作为字符串
Dim sSendBCC作为字符串
作为字符串的Dim SSObject
作为字符串的Dim sTemp
作为变体的Dim vDB
Set-OutApp=CreateObject（“Outlook.Application”）
OutApp.Session.Logon
vDB=表1.范围（“a1”）.当前区域
对于lRow=2至UBound（vDB，1）
如果vDB（irow，6）“已发送”，则
如果vDB（lRow，5）“，则.BCC=sSendBCC
.Subject=ssobject
sTemp=“你好，”&vbCrLf&vbCrLf
sTemp=sTemp&“到期日已到”
sTemp=sTemp&“对于此项目：”&vbCrLf&vbCrLf
'假定项目名称在B列中
sTemp=sTemp&&&Cells（lRow，2）&vbCrLf&vbCrLf
sTemp=sTemp&“请选择适当的”
sTemp=sTemp&“动作”&vbCrLf&vbCrLf
sTemp=sTemp&“请将照片转发给BAS。HSGReporting@hpw.qld.gov.au.“&vbCrLf&vbCrLf&vbCrLf&vbCrLf&vbCrLf
sTemp=sTemp&“谢谢你。”
.Body=sTemp
'将以下内容更改为。如果需要，请发送
'在不先查看的情况下发送消息
拯救
.发送
.展示
以
发送邮件=无
vDB（lRow，6）=“已发送”
vDB（lRow，7）=“电子邮件发送日期：”&Now（）
如果结束
如果结束
下一条路
设置应用程序=无
表1.范围（“a1”）。调整大小（UBound（vDB，1），UBound（vDB，2））=vDB
端接头

如果要在达到某个值后发送电子邮件，可以使用下面的代码/概念

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "Cell A1 is changed" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

有几个问题：

sSendTo=Sheet1.Range.Columns（C）和lLastRow.Value

```
Sheet1
```
看起来像一个变量，但您尚未声明它，因此我假定您指的是名为“Sheet1”的工作表，即
```
ActiveWorkbook.Worksheets（“Sheet1”）
```
```
Columns（C）
```
：同样
```
C
```
看起来像一个变量，但您尚未声明它，因此我假定您指的是“C”列（即工作表中的第三列）
只有一个左括号
```
（
```
（在
```
C
```
之前），但有两个右括号
```
）
```
（一个在
```
C
```
之后，一个在
```
lLastRow
```
之后）
```
.Range.Columns（C）&lLastRow
```
不是很正确，但我知道你想做什么

应该是：

sSendTo=ActiveWorkbook.Worksheets（“Sheet1”）.Cells（lLastRow，“C”）.Value

或：

sSendTo=ActiveWorkbook.Worksheets（“Sheet1”）.Range（“C”和lLastRow）.Value

提示：将

Option Explicit

添加到每个模块的顶部。

尝试更改代码的outlook部分。在

.to=

行中添加

&单元格（lRow，3）

 With OutMail
'Adds values in column C as recipients 
                .To = sSendTo & Cells(lRow, 3)
                If sSendCC > "" Then .CC = sSendCC
                If sSendBCC > "" Then .BCC = sSendBCC
'Includes project name (column B) in the Subject
                .Subject = sSubject & " - " & Cells(lRow, 2)

这也会将项目的名称放入主题中

Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

' Change the following as needed
sSendTo = ""
sSendCC = ""
sSendBCC = "YourEmail@you.com"
sSubject = "Due date reached"

lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For lRow = 2 To lLastRow
    If Cells(lRow, 6) <> "S" Then
        If Cells(lRow, 5) <= Date Then
            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
'Adds values in column C as recipients 
                .To = sSendTo & Cells(lRow, 3)
                If sSendCC > "" Then .CC = sSendCC
                If sSendBCC > "" Then .BCC = sSendBCC
'Includes project name (column B) in the Subject
                .Subject = sSubject & " - " & Cells(lRow, 2)

                sTemp = "Hello!" & vbCrLf & vbCrLf
                sTemp = sTemp & "The due date has been reached "
                sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
                ' Assumes project name is in column B
                sTemp = sTemp & "    " & Cells(lRow, 2) & vbCrLf & vbCrLf
                sTemp = sTemp & "Please take the appropriate "
                sTemp = sTemp & "action." & vbCrLf & vbCrLf
                sTemp = sTemp & "Thank you!" & vbCrLf

                .Body = sTemp
                ' Change the following to .Send if you want to
                ' send the message without reviewing first
                .Display
            End With
            Set OutMail = Nothing

            Cells(lRow, 6) = "S"
            Cells(lRow, 7) = "E-mail sent on: " & Now()
        End If
    End If
Next lRow
Set OutApp = Nothing
End Sub

子工作簿\u Open（）
Dim OutApp作为对象
将邮件变暗为对象
昏暗的灯塔一样长
暗淡的光线和长的一样
迪姆森托