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:
Nebunyka pe Simpatie.ro
 | Femeie
21 ani
Bacau
cauta Barbat
21 - 52 ani |
|
TonyTzu
Moderator
 Inregistrat: acum 12 ani
Postari: 252
|
|
The source is a very good one for many excel based tricks. But these specific links refer to sending emails via excel:
Mail a message to each person in a range via OUTLOOK -
Send a mail via OUTLOOK when a cell reaches a certain value -
Here, if you don't have outlook and want to just send mail -
The macro below will send mail when you press a button called "Check". Say you have a list of 1000 and you want to be announced 15 days before the dates are due.
The only problem is that you have to periodically enter the file with the list and press the button.
Sub Test2()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "EXPIRA FISA MEDICALA A LUI " & Cells(cell.Row, "E").Value
.Body = "Atentie! " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Fisa medicala pentru " & Cells(cell.Row, "E").Value & " " & _
"va expira in mai putin de 10 zile!"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send
'.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub |
Tips
You can also use the values of cells in a range as the body text.
This example will add all the text/values that are in the range G1:G20 to the body.
Add this code to the sub before the loop start
Dim strbody As String
For Each cell In Range("G1:G20")
strbody = strbody & cell.Value & vbNewLine
Next
And replace the body line with this one
.Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
If you want to create emails that are formatted you can use HTMLBody (Office 2000 and up) instead of Body. You can find a lot of WebPages on the internet with more HTML tags examples.
.HTMLBody = "<H3><B>Dear " & cell.Offset(0, -1).Value & "</B></H3>" & _
"Please contact us to discuss bringing your account up to date.<BR><BR>" & _
"<B>Regards Ron de Bruin</B>"
|
|
| pus acum 7 ani |
|
TonyTzu
Moderator
Inregistrat: acum 12 ani
Postari: 252
|
|
To make it run daily at a specified time I used the Windows Task Scheduler
You will have to create 2 other files, one called script.vbs and one called run.bat. You will add run.bat to Task Scheduler.
script.vbs:
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = False
objExcel.Run "Test2"
objExcel.ActiveWorkbook.Save
objExcel.DisplayAlerts = False
objExcel.ActiveWorkbook.Close
objExcel.Quit |
run.bat
cscript "C:\Test\script.vbs" "C:\Test\Book1.xlsm"
exit |
close all instances of excel vbs file
Option Explicit
Dim objWMIService, objProcess, colProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & "'EXCEL.EXE'")
For Each objProcess in colProcess
objProcess.Terminate()
Next |
If something is not working with your bat file and want to see what, on the next line in the bat file, write: pause
To start it minimized (display the cmd window in taskbar), you will have to add arguments to your action when adding it in Task Scheduler.
So put the following:
Run/script: cmd
Arguments: /c start "Check" /min "C:\Test\run.bat"
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)
Source for starting minimized
Source videos:
Code:
https://www.youtube.com/watch?v=oC_i1Cf9O2w
and
https://www.youtube.com/watch?v=lFSgV2gym9g |
|
|
| pus acum 7 ani |
|
TonyTzu
Moderator
Inregistrat: acum 12 ani
Postari: 252
|
|
If, for some reason, you want the task to run even if you are not logged on, see this link:
|
|
| pus acum 7 ani |
|
TonyTzu
Moderator
Inregistrat: acum 12 ani
Postari: 252
|
|
For sending email from another Outlook account, assuming you have more than 1:
First, find out which account number is the one you want to use - create new macro and run it:
Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
Dim OutApp As Outlook.Application
Dim I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub |
Then to your macro, add the following lines after .Body:
'Change Item(2) to the account number that you want to use:
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
If it doesn't work, write the last line with Set:
Set .SendUsingAccount = OutApp.Session.Accounts.Item(2)
*****
You can also send on behalf of someone else, but you must use an Exchange account to be able to do that:
This line should be added, once you have permissions (you are set as a Delegate on their account):
.SentOnBehalfOfName = """XXXXX"" <XXXXX@yahoo.com>"
|
|
| pus acum 6 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2228
|
|
To add more than 1 condition on which to send email (more FOR functions), you could use this approach (part of code):
With Sheets("Sheet1")
'#### Store To and CC email Addresses, Build temporary Body string based on Yes in Column D ####
For Each cell In Columns("R").Cells.SpecialCells(xlCellTypeConstants) 'if not working or working slow, add ' before .SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "P").Value) = "yes" Then
toAddy = cell.Value
'ccAddy = Cells(cell.Row, "C").Value
'bccAddy = "yourname@yourcompany.com"
tmpBody = tmpBody & "<p></p>" & _
"- something <b>IMPORTANT</b> for <b><font color=red>" & _
Cells(cell.Row, "F").Value & "</b></font>, next value description: " & _
Cells(cell.Row, "G").Value & " and internal no " & _
Cells(cell.Row, "M").Value & " from <b><font color=green>" & _
Cells(cell.Row, "C").Value & ", " & _
Cells(cell.Row, "D").Value & ", " & _
Cells(cell.Row, "E").Value & "</font></b> with no: " & _
Cells(cell.Row, "H").Value & ", it runs out on <b><font color=red>" & _
Cells(cell.Row, "J").Value & "</b></font>, in: <u>" & _
Cells(cell.Row, "T").Value & "</u> <b><font color=fuchsia>" & _
Cells(cell.Row, "N").Value & _
Cells(cell.Row, "S").Value & "</b></font> " & _
vbNewLine & vbNewLine
End If
Next cell
For Each cell In Columns("R").Cells.SpecialCells(xlCellTypeConstants) 'if not working or working slow, add ' before .SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "Q").Value) = "yes" Then
toAddy = cell.Value
'ccAddy = Cells(cell.Row, "C").Value
'bccAddy = "yourname@yourcompany.com"
tmpBody = tmpBody & "<p></p>" & _
"- something <u>ELSE IMPORTANT</u> for <b><font color=red>" & _
Cells(cell.Row, "F").Value & "</b></font>, next value description: " & _
Cells(cell.Row, "G").Value & " and internal no " & _
Cells(cell.Row, "M").Value & " from <b><font color=green>" & _
Cells(cell.Row, "C").Value & ", " & _
Cells(cell.Row, "D").Value & ", " & _
Cells(cell.Row, "E").Value & "</font></b> with no: " & _
Cells(cell.Row, "H").Value & ", it runs out on <b><font color=red>" & _
Cells(cell.Row, "K").Value & "</b></font>, in: <u>" & _
Cells(cell.Row, "U").Value & "</u> <b><font color=fuchsia>" & _
Cells(cell.Row, "O").Value & _
Cells(cell.Row, "S").Value & "</b></font> " & _
vbNewLine & vbNewLine
End If
Next cell
End With
'#### Complete Body string ####
tmpBody = "ATTENTION! <br></br> <br></br>" & vbNewLine & vbNewLine & _
"Something: <br></br> <br></br>" & vbNewLine & _
tmpBody & _
"Something more" |
_______________________________________
|
|
| pus acum 6 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2228
|
|
Note:
If you check task scheduler and it seems that your task keeps on running even after the macro has finished, even if you set the task to close after 1 minute, you can click the Refresh option of the right of Task Scheduler:
It should turn from Running to Ready. Thing is that Task Scheduler doesn't have auto-refresh.
_______________________________________
|
|
| pus acum 6 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2228
|
|
Updated
_______________________________________
|
|
| pus acum 6 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 787
|
|
Better use the for loop in this post:
Modificat de TRaP (acum 6 ani)
|
|
| pus acum 6 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2228
|
|
Updated - added alternative to Task Scheduler - in post #2
_______________________________________
|
|
| pus acum 5 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 787
|
|
To get better formatted and visible data in e-mail body, you can set it up in HTML table.
Use the following code:
Dim firma, data, tip, detalii, zile, obs
tmpBody = "<!DOCTYPE html><html><body>"
tmpBody = tmpBody & "<table style='width:100%'>" '"<table style='border-spacing: 0px; border-style: solid; border-color: #ccc; border-width: 0 0 1px 1px;'>"
'Store To and CC email Addresses, Build temporary Body string based on Yes in Column H
For Each cell In Worksheets("Sheet2").Range("H3:H" & LastRow).Cells
If Worksheets("Sheet2").Cells(cell.Row, "H").Value = "YES" Then
toAddy = "email@email.com"
firma = Worksheets("Sheet2").Cells(cell.Row, "A").Value
data = Worksheets("Sheet2").Cells(cell.Row, "F").Value
tip = Worksheets("Sheet2").Cells(cell.Row, "B").Value
detalii = Worksheets("Sheet2").Cells(cell.Row, "C").Value
zile = Worksheets("Sheet2").Cells(cell.Row, "G").Value
obs = Worksheets("Sheet2").Cells(cell.Row, "J").Value
' <td style='padding: 5px; border-style: solid; border-color: #ccc; border-width: 1px 1px 0 0;'>
tmpBody = tmpBody & "<tr>"
tmpBody = tmpBody & "<td style='width:5%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> <b><font color=red> " & firma & "</font></b></td>"
tmpBody = tmpBody & "<td style='width:5%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> " & data & "</td>"
tmpBody = tmpBody & "<td style='width:7%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> <b><font color=green> " & tip & "</font></b></td>"
tmpBody = tmpBody & "<td style='width:25%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> <b><font color=blue> " & detalii & "</font></b></td>"
tmpBody = tmpBody & "<td style='width:5%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> <b><font color=red> " & zile & "</font></b></td>"
tmpBody = tmpBody & "<td style='width:53%; padding: 2px; border-style: solid; border-color: #ccc; border-width: 0 1px 0 0;'> <b> " & obs & "</td>"
tmpBody = tmpBody & "</tr>"
End If
Next cell
tmpBody = tmpBody & "</table></div></body></html>" |
Source:
|
|
| pus acum 3 ani |
|
