Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
sweet_barbie
 | Femeie
24 ani
Mehedinti
cauta Barbat
24 - 46 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
The code below should work with no email software required for it to send the email. For more info and explanation and for the source of this code, check Ron de Bruin's page:
Similar, bit different:
The code below will require you to add your email and password. You can create an email specifically to send alert emails, so you won't use your main account's password in an excel file. But you can also protect the VBA code with a password from Visual Basic, so no one has access to the code and your email pass is protected. Here's how to do it:
IMPORTANT! If you change your email password, you must also change it in VBA, otherwise it will not work.
Sub EMAILALERTS()
Dim iMsg, iConf As Object
Dim Flds As Variant
Dim cell As Range
Dim LastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set iConf = CreateObject("CDO.Configuration")
LastRow = Sheets("emailALERTS").Cells(Rows.Count, "I").End(xlUp).Row
iConf.Load -1 'CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YOUREMAILADDRESS"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YOUREMAILADDRESSPASSWORD"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com" 'for gmail use smtp.gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
For Each cell In Sheets("emailALERTS").Range("I3:I" & LastRow)
If LCase(Sheets("emailALERTS").Cells(cell.Row, "I").Value) = "yes" Then
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = "YOUREMAILADDRESS"
.CC = ""
.BCC = ""
.From = """YOURNAME"" <YOUREMAILADDRESS>"
.Subject = "BLA BLA EMAIL SUBJECT " & _
Sheets("emailALERTS").Cells(cell.Row, "B").Value
.HTMLBody = "BLA, " & _
Sheets("emailALERTS").Cells(cell.Row, "M").Value & "!<p></p><br></br>" & "<b>BLA BLA BLA BLA BLA <font color=red>" & _
Sheets("emailALERTS").Cells(cell.Row, "B").Value & "</font> - <font color=blue>" & _
Sheets("emailALERTS").Cells(cell.Row, "C").Value & "</font></b>BLA BLA BLA BLA BLA " & _
Sheets("emailALERTS").Cells(cell.Row, "E").Value & "!<p></p><br></br>" & "BLA BLA BLA <b><font color=red>" & _
Sheets("emailALERTS").Cells(cell.Row, "H").Value & "</font></b> BLA BLA BLA!" & "!<p></p><br></br>" & _
"BLA BLA BLA BLA BLA THE END."
.Send
End With
Set iMsg = Nothing
End If
Next cell
Set iConf = Nothing
Set Flds = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
.vbs file:
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = False
objExcel.Run "EMAILALERTS"
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit |
.bat file:
cscript "FULL PATH TO YOUR VBS FILE\file.vbs" "FULL PATH TO YOUR EXCEL FILE\file.xlsm"
exit |
task scheduler set up for daily/weekly/monthly run of vba:
1. Create a new task
2. General TAB - name your task and add a description (optional, but useful)
3. Triggers TAB - click NEW: set frequency (daily, weekly, monthly), date to start, hour, minute, second. Click OK.
4. Actions TAB - click NEW: in the Program/script field insert: cmd
in the Add arguments (optional) field insert: /c start "RUN ALERTS" /min "FULL PATH TO YOUR BAT FILE\file.bat"
Click OK
5. Conditions TAB - If you have a laptop or UPS, you can check or uncheck "Start the task only if the computer is on AC power"and "Stop if the computer switches to battery power"
6. Settings TAB - check "Allow task to be run on demand"
check "Run task as soon as possible after a scheduled start is missed"
check "If the running task does not end when requested, force it to stop"
select "Do not start a new instance" from the dropdown list under "If the task is already running, then the following rule applies:". Or you can select another option if you prefer.
7. Click OK
If you don't want to use task scheduler for some reason (eg. I had some problems with it and it would not send e-mails every time), then you can use a FREEWARE:
IMPORTANT: YOU WILL STILL USE THE BAT AND VBS FILES, YOU ARE JUST NOT USING TASK SCHEDULER ANYMORE, BUT A 3RD PARTY SOFTWARE (Schedule Manager)
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
To add multiple conditions you can structure your code like this:
Sub EMAILALERTS()
Dim iMsg, iConf As Object
Dim Flds As Variant
Dim cell As Range
Dim LastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set iConf = CreateObject("CDO.Configuration")
LastRow = Sheets("SHEETNAME").Cells(Rows.Count, "L").End(xlUp).Row
iConf.Load -1 'CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YOUREMAILADDRESS"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YOUREMAILADDRESSPASSWORD"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com" 'for gmail use smtp.gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
'#### CHECK CONDITIONS AND BUILD HTML BODY ####
For Each cell In Sheets("SHEETNAME").Range("L3:L" & LastRow)
If LCase(Sheets("SHEETNAME").Cells(cell.Row, "P").Value) = "yes" Then
SHEETBody =SHEETBody & "<p></p>" & _
"<B><font color=BLUE>" & _
"BLA BLA BLA" & _
"</B></font> BLA <b><font color=BLUE>" & _
Sheets("SHEETNAME").Cells(cell.Row, "B").Value & "</b></font>, BLA BLA BLA: " & _
Sheets("SHEETNAME").Cells(cell.Row, "C").Value & " BLA BLA BLA: " & _
Sheets("SHEETNAME").Cells(cell.Row, "D").Value & ", BLA BLA BLA <b><font color=BLUE>" & _
Sheets("SHEETNAME").Cells(cell.Row, "F").Value & "</b></font>, BLA: <b><font color=RED>" & _
Sheets("SHEETNAME").Cells(cell.Row, "M").Value & " " & _
Sheets("SHEETNAME").Cells(cell.Row, "S").Value & "</b></font> <u>BLA BLA BLA:</u> <font color=RED><span style='background:yellow;mso-highlight:yellow'><b>" & _
Sheets("SHEETNAME").Cells(cell.Row, "I").Value & "</span></font></b>" & _
vbNewLine & vbNewLine
End If
If LCase(Sheets("SHEETNAME").Cells(cell.Row, "Q").Value) = "yes" Then
SHEETBody = SHEETBody & "<p></p>" & _
"<B><font color=CHOCOLATE>" & _
"BLA BLA BLA" & _
"</B></font> pentru <b><font color=CHOCOLATE>" & _
Sheets("SHEETNAME").Cells(cell.Row, "B").Value & "</b></font>, BLA BLA BLA: " & _
Sheets("SHEETNAME").Cells(cell.Row, "C").Value & " BLA BLA BLA: " & _
Sheets("SHEETNAME").Cells(cell.Row, "D").Value & ", BLA BLA BLA <b><font color=CHOCOLATE>" & _
Sheets("SHEETNAME").Cells(cell.Row, "G").Value & "</b></font>, BLA: <b><font color=RED>" & _
Sheets("SHEETNAME").Cells(cell.Row, "N").Value & " " & _
Sheets("SHEETNAME").Cells(cell.Row, "T").Value & "</b></font> <u>BLA BLA BLA:</u> <font color=RED><span style='background:yellow;mso-highlight:yellow'><b>" & _
Sheets("SHEETNAME").Cells(cell.Row, "I").Value & "</span></font></b>" & _
vbNewLine & vbNewLine
End If
'#### AND SO ON... THEN CLOSE FOR LOOP: ####
Next cell
'#### CREATE FULL BODY CONTENT OUTSIDE THE LOOP, BUT WHICH INCLUDES THE LOOP RESULTS ####
SHEETBody = "<b>ATTENTION!</b> <br></br> <br></br>" & vbNewLine & vbNewLine & _
SHEETBody & _
"<br></br> <br></br> BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA " & _
"BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA ." & _
vbNewLine & vbNewLine & _
"<br></br> <br></br> <b><font color=navy><u>BLA BLA BLA BLA BLA BLA </font></b></u>, " & _
"BLA <b>BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA </b> AND <u>BLA BLA BLA BLA BLA BLA BLA BLA BLA</u>.<p></p> " & _
"<b>BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA</b>, " & _
"BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA BLA."
'#### SEND EMAIL ####
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
.To = "YOUREMAILADDRESS"
.CC = ""
.BCC = ""
.From = """YOURNAME"" <YOUREMAILADDRESS>"
.Subject = "BLA BLA BLA BLA SUBJECT"
.HTMLBody = SHEETBody
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
Updated - added alternative to Task Scheduler - in post #2
_______________________________________
|
|
| pus acum 4 ani |
|