Question

I wrote a script that sends a mail to a person responsible for tasks on a given day.

 Private Sub Workbook_Open()
    Dim olApp As Object
    Dim olMail As Object
    xToday = Format(Now, "MM/DD/YYYY") 'change format to match yours

    Set findToday = Range("A1:B" & Range("A" & _
    Rows.Count).End(xlUp).Row).Find(xToday, , xlValues, xlWhole)

    If Not findToday Is Nothing Then
        person = Range("B" & findToday.Row)
        If person = vbNullString Then
            MsgBox "No person assigned for today"
            End
        End If
        Set olApp = CreateObject("Outlook.Application")
        Set olMail = olApp.createitem(0)
        With olMail
        .Subject = "xxx SHIFT"
        .to = "xxx"
        .cc = "person4@emailaddy.com"
        .bcc = ""
        .body = "Today, " & vbNewLine & person & " is responsible for doing stuff."
        .send
        End With
    Else
        MsgBox "Could not find the date"
    End If
End Sub

something is wrong with this...i gueess with the format of the date? as all the time I get the popup "could not find the date"... I tried with all data format combinations - but no luck

Anyone could help?

Answer 1

这个很小，对你有用：

Option Explicit

Public Sub TestMe()

    Dim xToday      As Date
    Dim searchRange As Range
    Dim findToday   As Range

    xToday = DateValue(Now)
    With Worksheets(1)
        Set searchRange = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
        Set findToday = searchRange.Find(xToday)
        findToday.Select
    End With

End Sub

我已另外声明Worksheets(1)，以避免使用ActiveWorksheet。我们的想法是您正确定义范围，并使用DateValue()，它只返回日期而不是时间。要查看差异，请运行：

Debug.Print Now
Debug.Print DateValue(Now)

关于您的屏幕截图以及使用与VBA不同的日期设置这一事实，最好采用以下方法 - 使用Application.Match找到日期所在的行。该列似乎是常量，因此始终为1.如果找到该行，则在第一列上将findToday设置为具有此行的单元格。如果您没有找到该行，则会将findRow变量分配给-1，从而将条件分配给MsgBox "Not Found"。准确复制此代码并尝试一下：

Option Explicit

Public Sub TestMe()

    Dim xToday      As Long
    Dim searchRange As Range
    Dim findToday   As Range

    xToday = DateValue(Now)
    With Worksheets(1)
        Set searchRange = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)

        Dim findRow As Long
        If IsError(Application.Match(xToday, searchRange.Columns(1), 0)) Then
            findRow = -1
        Else
            findRow = WorksheetFunction.Match(xToday, searchRange.Columns(1), 0)
        End If

        If findRow = -1 Then
            MsgBox "NOT FOUND!"
            Exit Sub
        Else
            Set findToday = .Cells(findRow, 1)
            findToday.Select ' in your case - send the mail, do not select
        End If     

    End With

End Sub

Answer 2

我做了以下操作但仍无法找到日期＆＃39;弹出：

Private Sub Workbook_Open()



Dim xToday      As Date
Dim searchRange As Range


xToday = DateValue(Now)
With Worksheets(1)
    Set searchRange = .Range("A1:B" & .Range("A" & 
.Rows.Count).End(xlUp).Row)
    Set findToday = searchRange.Find(xToday)

If Not findToday Is Nothing Then
    person = Range("B" & findToday.Row)
    If person = vbNullString Then
        MsgBox "No person assigned for today"
        End
    End If
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.createitem(0)
    With olMail
    .Subject = "xxx SHIFT"
    .to = "xxx"
    .cc = "person4@emailaddy.com"
    .bcc = ""
    .body = "Today, " & vbNewLine & person & " is responsible for doing 
     stuff."
    .send
    End With
Else
    MsgBox "Could not find the date"
End If

End With


End Sub

代码有什么问题？

Sending an email to a responsible user

2 个答案: