获取周六和周日日期以发送生日祝福

Question

大家好，我对宏以及如何设置它有点陌生。

我正在尝试运行一个自动生日宏，它会向人们发送一封电子邮件，说生日快乐。

但我正在努力解决星期一的问题，我希望它也能在周末生日时发送一条消息，但仅限于星期一。我的代码一直说“运行时错误'13'：类型不匹配”。这是我的代码，请帮忙，因为我已经为此苦苦挣扎了一周

Sub send_bday_greet2()
  Dim i As Long
  Dim vbSunday As String, vbSaturday As String

    For i = 2 To Sheets("Sheet1").Range("a1048576").End(xlUp).Row
        If Day(Now()) = Day(CDate(Sheets("Sheet1").Range("c" & i).Value)) And Month(Now()) = Month(CDate(Sheets("Sheet1").Range("c" & i).Value)) Then
            Call sending_bday_greetings_method2(Sheets("Sheet1").Range("a" & i).Value, Sheets("Sheet1").Range("b" & i).Value)

            ElseIf Day(Now(vbMonday)) = Day(CDate(Sheets("Sheet1").Range("c" & i).Value)) And Month(Now(vbSaturday)) And Month(Now(vbSunday)) = Month(CDate(Sheets("Sheet1").Range("c" & i).Value)) Then

                Call sending_bday_greetings_method2(Sheets("Sheet1").Range("a" & i).Value, Sheets("Sheet1").Range("b" & i).Value)

            End If
    Next
End Sub


Sub sending_bday_greetings_method2(nm As String, emid As String)

 Dim olApp As Outlook.Application
 Dim olMail As MailItem

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

s = "<p> <p align='left'><font size='3' face='arial' color='blue'><i> Dear " & nm & ", </p>" & vbNewLine

s = s & "<p> <p align='CENTER'><font size='3' face='arial' color='red'><i> We Wish you a very Happy Birthday! </p>" & vbNewLine

s = s & "<left><p align='CENTER'><img src=""http://simplyizzy.files.wordpress.com/2012/05/happy_birthday1.png"">" & vbNewLine

s = s & vbNewLine & "<left><p><p align='Left'><font size='3' face='arial' color='blue'><i>Regards<br>" & "Reutech Radar Systems</p>"

With olMail
    .To = emid
    .Subject = "Happy B'day!"
    .HTMLBody = s
    .Send
End With

Set olApp = Nothing
Set olMail = Nothing

End Sub

Answer 1

您的第一个问题是Dim vbSunday As String, vbSaturday As String。

vbSaturday 和 vbSaturday 是 VBA 中的常量，它们是数字，您正在尝试将它们用作字符串。

此外，它们很可能受到保护，因此您将无法将它们的名称用作变量的名称。

---

您的第二个问题是Now(vbMonday) 和其他问题，您需要使用这样的函数来获取当前日期的最后一天：

Public Function GetLastDay(ByVal DayAsVbConstant As Integer) As Date
    GetLastDay = Now - (Weekday(Now, DayAsVbConstant) - 1)
End Function

---

这是您的代码的修订版：

Sub send_bday_greet2()
Dim i As Long
Dim wS As Worksheet
Dim SendMessage As Boolean
Dim BirthDay As Date
'Set wS = ThisWorkbook.Sheets("Sheet1")
Set wS = ThisWorkbook.Sheets("Feuil1")

With wS
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        SendMessage = False
        BirthDay = CDate(.Range("C" & i).Value)
        Select Case True
            Case Day(Now()) = Day(BirthDay) And Month(Now()) = Month(BirthDay)
                'Birthday this day
                SendMessage = True
            Case Weekday(Now) = vbMonday And ( _
                    Day(GetLastDay(vbSaturday)) = Day(BirthDay) And _
                    Month(GetLastDay(vbSaturday)) = Month(BirthDay))
                'Birthday on Saturday
                SendMessage = True
            Case Weekday(Now) = vbMonday And ( _
                        Day(GetLastDay(vbSunday)) = Day(BirthDay) And _
                        Month(GetLastDay(vbSunday)) = Month(BirthDay))
                'Birthday on Sunday
                SendMessage = True
            Case Else

        End Select
        If SendMessage Then Call sending_bday_greetings_method2(.Range("a" & i).Value, .Range("b" & i).Value)
    Next i
End With 'wS
End Sub

以及发送邮件的部分：

Sub sending_bday_greetings_method2(ByVal nm As String, ByVal emid As String)
    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)

    s = "<p> <p align='left'><font size='3' face='arial' color='blue'><i> Dear " & nm & ", </p>" & vbNewLine
    s = s & "<p> <p align='CENTER'><font size='3' face='arial' color='red'><i> We Wish you a very Happy Birthday! </p>" & vbNewLine
    s = s & "<left><p align='CENTER'><img src=""http://simplyizzy.files.wordpress.com/2012/05/happy_birthday1.png"">" & vbNewLine
    s = s & vbNewLine & "<left><p><p align='Left'><font size='3' face='arial' color='blue'><i>Regards<br>" & "Reutech Radar Systems</p>"

    With olMail
        .To = emid
        .Subject = "Happy B'day!"
        .HTMLBody = s
        .Display
        '.Send
    End With

    Set olApp = Nothing
    Set olMail = Nothing
End Sub