1、创建txt文件，将一下代码复制到里面，后缀名改为.vbs
2、创建计划任务，定时执行（不会的百度或者留言）
3、准备好对应的excel 和背景图，excel有三列，姓名生日和邮箱
Function sendEmail(nameVal, myBirthdayVal, myEmailVal, content1, content2)
OnErrorResumeNext
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "发件箱"
Email.To = myEmailVal
Email.Subject = "ףģɺȕ쀖"
Email.AddAttachment "D:\1.jpg"
Email.htmlBody = "<body background='cid:1.jpg'>ӊĚȝ"&"<h1>"& nameVal & "</h1>"& myBirthdayVal& content1& content2 & "</body>"
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "服务器"
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = "用户名"
.Item(NameSpace&"sendpassword") = "密码"
.Update
EndWith
Err.Clear
Email.Send
If Err.Number <> 0Then
SendMail = False
MsgBox "error"
Else
SendMail = True
'MsgBox "success"
EndIf
Set Email = Nothing
EndFunction
Function ReadExcel()
myExcelName = "3.xlsx"
time1 = Now
myExcelPath = "D:\3.xlsx"
Set myExcel = CreateObject("Excel.Application")
myExcel.Workbooks.Open myExcelPath
myExcel.Visible = False
myExcel.Windows(myExcelName).Activate
'?ኾĚȝ
content1 = myExcel.Sheets("config").Cells(2,2).Value
content2 = myExcel.Sheets("config").Cells(3,2).Value
'?Њ
RowCount = myExcel.Sheets("Sheet1").usedrange.rows.Count
'ѭˍ
'?Еû ɺȕ ӊϤ
nameCol = 1
birthdayCol = 2
eMailCol = 3
isSend = 4
For i = 2To RowCount
isSendVal = 0
nameVal = myExcel.Sheets("Sheet1").Cells(i, nameCol).Value
myBirthdayVal = myExcel.Sheets("Sheet1").Cells(i, birthdayCol).Value
myEmailVal = myExcel.Sheets("Sheet1").Cells(i, eMailCol).Value
isSendVal = myExcel.Sheets("Sheet1").Cells(i, isSend).Value
If myExcel.Sheets("Sheet1").Cells(i, eMailCol) = ""Then
MsgBox "ڢ & i & "А Еû" & nameVal & "ɺȕ" & myBirthdayVal
Else
myBirthday = myExcel.Sheets("Sheet1").Cells(i, birthdayCol).Value
'ȧʇ?ȕˍɺȕӊ
If Month(Now) = Month(myBirthdayVal) And Day(Now) = Day(myBirthdayVal) And isSendVal <> 1Then
Dim arrPara
arrPara = Array(nameVal, myBirthdayVal, myEmailVal, content1, content2)
Call sendEmail (nameVal, myBirthdayVal, myEmailVal, content1, content2)
myExcel.Sheets("Sheet1").Cells(i, isSend).Value = 2
EndIf
EndIf
Next
myExcel.Workbooks(1).Save
myExcel.Workbooks(myExcelName).Close
myExcel.Quit
time2 = Now
EndFunction
ReadExcel
4135
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
