L
lehainam
Dear all,
I am using Microsoft Outlook 2002 SP3.
I am using the below to send email to many people (100 pers) :
Sub Mail_With_Outlook_Bonus()
On Error GoTo Mail_With_Outlook_Err
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Dim strforex As String, strDate
Dim x As Integer
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Data").Activate
x = Range("A65536").End(xlUp).Row
strsub = Cells(2, 5).Value
strforex = Cells(3, 5).Value
strDate = Cells(4, 5).Value
Set OutApp = CreateObject("Outlook.Application")
For i = 2 To x
If Cells(i, 4).Value Like "*@*" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
..To = Cells(i, 4).Value
..Subject = strsub
..Body = "Dear Mr./Ms. " & Cells(i, 2) & "," & Chr(13) & Chr(13)
_
& "Please be kindly informed that your bonus has been paid on "
_
& strDate & " with the details as belows:" & Chr(13) _
& Chr(13) & " " & "Exchange Rate: " & strforex & Chr(13)
_
& " " & "Amount: " & Cells(i, 3) & Chr(13) _
& " Your bonus is based on gross salary (basic salary x
1.35)" _
& Chr(13) & Chr(13) & " Should you have any queries, please
feel free" _
& " contact Accounting Department." & Chr(13) & Chr(13) _
& "Regards," & Chr(13) & Chr(13) & Chr(13) & "Nam"
..Send
End With
End If
Next
Set OutMail = Nothing
Set OutApp = Nothing
Mail_With_Outlook_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
Mail_With_Outlook_Err:
MsgBox Err.Description
Resume Mail_With_Outlook_Exit
End Sub
However, the System asks me to confirm by click Yes and I go to the
website to preventing from clicking Yes:
http://www.contextmagic.com/express-clickyes/for-developers.htm
and try to put my Code as below:
'Declare Windows' API functions
Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Sub SomeProc()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
' Register a message to send
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
' Find ClickYes Window by classname
wnd = FindWindow("EXCLICKYES_WND", 0&)
' Send the message to Resume ClickYes
Res = SendMessage(wnd, uClickYes, 1, 0)
' ...
' Do some Actions
' ...
' Send the message to Suspend ClickYes
Mail_With_Outlook_Bonus
Res = SendMessage(wnd, uClickYes, 0, 0)
End Sub
However, the System still asks me to confirm by clicking Yes button.
Could any one can help me!
Thanks a lot!
Nam
I am using Microsoft Outlook 2002 SP3.
I am using the below to send email to many people (100 pers) :
Sub Mail_With_Outlook_Bonus()
On Error GoTo Mail_With_Outlook_Err
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Dim strforex As String, strDate
Dim x As Integer
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Data").Activate
x = Range("A65536").End(xlUp).Row
strsub = Cells(2, 5).Value
strforex = Cells(3, 5).Value
strDate = Cells(4, 5).Value
Set OutApp = CreateObject("Outlook.Application")
For i = 2 To x
If Cells(i, 4).Value Like "*@*" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
..To = Cells(i, 4).Value
..Subject = strsub
..Body = "Dear Mr./Ms. " & Cells(i, 2) & "," & Chr(13) & Chr(13)
_
& "Please be kindly informed that your bonus has been paid on "
_
& strDate & " with the details as belows:" & Chr(13) _
& Chr(13) & " " & "Exchange Rate: " & strforex & Chr(13)
_
& " " & "Amount: " & Cells(i, 3) & Chr(13) _
& " Your bonus is based on gross salary (basic salary x
1.35)" _
& Chr(13) & Chr(13) & " Should you have any queries, please
feel free" _
& " contact Accounting Department." & Chr(13) & Chr(13) _
& "Regards," & Chr(13) & Chr(13) & Chr(13) & "Nam"
..Send
End With
End If
Next
Set OutMail = Nothing
Set OutApp = Nothing
Mail_With_Outlook_Exit:
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
Mail_With_Outlook_Err:
MsgBox Err.Description
Resume Mail_With_Outlook_Exit
End Sub
However, the System asks me to confirm by click Yes and I go to the
website to preventing from clicking Yes:
http://www.contextmagic.com/express-clickyes/for-developers.htm
and try to put my Code as below:
'Declare Windows' API functions
Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Sub SomeProc()
Dim wnd As Long
Dim uClickYes As Long
Dim Res As Long
' Register a message to send
uClickYes = RegisterWindowMessage("CLICKYES_SUSPEND_RESUME")
' Find ClickYes Window by classname
wnd = FindWindow("EXCLICKYES_WND", 0&)
' Send the message to Resume ClickYes
Res = SendMessage(wnd, uClickYes, 1, 0)
' ...
' Do some Actions
' ...
' Send the message to Suspend ClickYes
Mail_With_Outlook_Bonus
Res = SendMessage(wnd, uClickYes, 0, 0)
End Sub
However, the System still asks me to confirm by clicking Yes button.
Could any one can help me!
Thanks a lot!
Nam