获取周六和周日日期以发送生日祝福 [英] Get Saturday and Sunday date to send Birthday's greeting

问题描述

大家好，我是这些宏的新手，以及如何进行设置.

Hi Guys I'm kind of new to the macros and how to set it up.

我正在尝试运行一个自动的生日宏，以将电子邮件发送给说生日快乐消息的人.

I'm trying to run a automatic birthday macros that send an email out to people saying a happy birthday message.

但是我正为周一的星期一而苦恼，我希望它也为周末的生日发出消息，但仅限于星期一.我的代码一直在说运行时错误'13':类型不匹配".这是我的代码，请耐心等待一周，因为我一直在努力

but I'm struggling with when its Monday i want it to initiate a message for the weekend birthdays as well, but only on a Monday. My Code keeps saying "Run-time error '13': type mismatch". Here is my Code please help as I've been struggling a week with it

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

推荐答案

您的第一个问题是将vbSunday设置为字符串，将vbSaturday设置为字符串.

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

vbSaturday and vbSaturday are constants in VBA that are numbers, and you're trying to use them as String.

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

Furthermore, they are most probably protected so you won't be able to use their names as variable's name.

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

Your second issue is with Now(vbMonday) and others, you'll need to use a function like this to get the last day from the current date :

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

---

这是您的代码的修订版:

---

Here is a revision of your code :

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

这篇关于获取周六和周日日期以发送生日祝福的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！