基于范围中的值触发操作

时间:2017-10-18 01:31:42

标签: vba excel-vba excel

我的工作表包含:
Col A中的项目编号 项目描述Col B
项目经理电子邮件地址Col C
日期字段Col D和E
已发送状态Col F
发送日期Col G

我希望在到达截止日期后发送电子邮件,并在电子表格的适用行中提供详细信息。

我让它运行,但它特定于细胞" A2"和" C2"。

我试图修改我的代码以反映代替" A2"引用但收到"编译错误语法错误"引用此行的消息,突出显示为红色:

_ViewImports.cshtml

我的代码是:

using Microsoft.AspNetCore.Mvc.ViewFeatures;
using Microsoft.AspNetCore.Razor.TagHelpers;
using Microsoft.AspNetCore.Mvc.TagHelpers;

namespace ValidationSampleWebApplication
{
    [HtmlTargetElement("div", Attributes = ValidationForAttributeName)]
    public class MytValidationMessageTagHelper : ValidationMessageTagHelper
    {
        private const string ValidationForAttributeName = "asp-validation-for";
        public MytValidationMessageTagHelper(IHtmlGenerator generator) : base(generator)
        {
        }
    }
}

我是VBA的新手。

4 个答案:

答案 0 :(得分:1)

有一些问题:sSendTo = Sheet1.Range.Columns(C) & lLastRow).Value

  • Sheet1看起来像一个变量,但你还没有声明它,所以我假设你指的是名为“Sheet1”的工作表,即ActiveWorkbook.Worksheets("Sheet1")
  • Columns(C)C看起来像一个变量,但你没有声明它,所以我假设你指的是列“C”(即工作表中的第三列)< / LI>
  • 您只有一个左括号(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添加到每个模块的顶部。

答案 1 :(得分:0)

试试这个:

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

答案 2 :(得分:0)

如果您想在达到价值后发送电子邮件,可以使用下面的代码/概念。

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

https://www.rondebruin.nl/win/s1/outlook/bmail9.htm

答案 3 :(得分:0)

请尝试更改代码的Outlook部分。在& Cells(lRow, 3)行中添加.to =

 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