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

时间:2017-03-07 08:41:45

标签: excel vba excel-vba

嗨大家我对这些宏有点新意,以及如何设置它。

我正在尝试运行一个自动生日宏,向发送生日快乐消息的人发送电子邮件。

但我正在努力解决星期一的问题,我希望它能为周末生日发送一条消息,但仅限于星期一。我的代码一直说“运行时错误'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

1 个答案:

答案 0 :(得分:0)

您的第一个问题是if symbolA.contains(element { //TODO: }

Dim vbSunday As String, vbSaturday As StringvbSaturday是VBA中的常量数字,您尝试将它们用作String。

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

你的第二个问题是vbSaturday和其他问题,你需要使用这样的函数来获取当前日期的最后一天:

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