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-...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


--
lehainam
------------------------------------------------------------------------
lehainam's Profile: http://www.excelforum.com/member.php...o&userid=18615
View this thread: http://www.excelforum.com/showthread...hreadid=401771

Have you thought about simply using your Excel file as a datafile for a
MS Word mail merge (to Outlook email)? It sounds like that might be a
lot easier than going through all this.

lehainam wrote:
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-...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


--
lehainam
------------------------------------------------------------------------
lehainam's Profile: http://www.excelforum.com/member.php...o&userid=18615
View this thread: http://www.excelforum.com/showthread...hreadid=401771

Dear Ron,

Thank you for your instruction.

However, I am using my company email and IT man told me that I am only
allowed to use Microsoft Outlook. I am also not allowed to install
ClickYes program.

Is there any VBA Code to solve this issue.

Thanks a lot!

Nam


--
lehainam
------------------------------------------------------------------------
lehainam's Profile: http://www.excelforum.com/member.php...o&userid=18615
View this thread: http://www.excelforum.com/showthread...hreadid=401771

You can try SendKeys

http://www.rondebruin.nl/mail/prevent.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


"lehainam" wrote in message
...

Dear Ron,

Thank you for your instruction.

However, I am using my company email and IT man told me that I am only
allowed to use Microsoft Outlook. I am also not allowed to install
ClickYes program.

Is there any VBA Code to solve this issue.

Thanks a lot!

Nam


--
lehainam
------------------------------------------------------------------------
lehainam's Profile: http://www.excelforum.com/member.php...o&userid=18615
View this thread: http://www.excelforum.com/showthread...hreadid=401771