본문
아웃룩 임시저장함에 있는 메일 한번에 보내기
아웃룩에서 매크로를 사용하여 한번에 수천통의 메일을 보내다보면 메일발송 진행이 멈추는 경우가 생긴다. 아마 서버측에서 부하가 걸린것으로 생각하며 보낼 메일들을 잠시 다른곳에다가 옮겼다가 나중에 발송을 재개하는 방법을 사용하는데, 이때 아래의 스크립트를 사용한다. Alt+F11을 눌러서 VBA창을 띄우고 이 코드를 입력한 후 F5버튼을 눌러 코드를 실행시키면 끝이다. (원작자는 0.5초 딜레이를 중간중간에 두는 배려도 잊지않았다.)
코드를 약간 수정하면 특정 폴더내에 있는 메일들을 전달하는 기능도 사용할 수 있다. 다음 게시물에서는 회사 네트워크 환경에서 규칙을 사용하는 방법으로 수신 메일을 전달하는 기능에 대해 작성할 예정이다. 그림이 들어가고 몇몇 부연설명이 필요하기 때문에 분리하여 작성한다.
'Declare Sleep API
Private Declare Sub Sleep Lib "kernel32" ( ByVal nMilliseconds As Long )
Sub SendAllDrafts ( )
' Send the messages in the Drafts folder (ignore any subfolders)
If MsgBox ( "Are you sure you want to send ALL the items in your default Drafts folder?" , _
vbQuestion + vbYesNo ) <> vbYes Then Exit Sub
Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace ( "MAPI" ) .GetDefaultFolder ( olFolderDrafts )
intCount = 0
Do While fldDraft.Items.Count > 0
Set msg = fldDraft.Items ( 1 )
msg.Send
Sleep 500
intCount = intCount + 1
Loop
If Not ( msg Is Nothing ) Then Set msg = Nothing
Set fldDraft = Nothing
MsgBox intCount & " messages sent" , vbInformation + vbOKOnly
End Sub
Private Declare Sub Sleep Lib "kernel32" ( ByVal nMilliseconds As Long )
Sub SendAllDrafts ( )
' Send the messages in the Drafts folder (ignore any subfolders)
If MsgBox ( "Are you sure you want to send ALL the items in your default Drafts folder?" , _
vbQuestion + vbYesNo ) <> vbYes Then Exit Sub
Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace ( "MAPI" ) .GetDefaultFolder ( olFolderDrafts )
intCount = 0
Do While fldDraft.Items.Count > 0
Set msg = fldDraft.Items ( 1 )
msg.Send
Sleep 500
intCount = intCount + 1
Loop
If Not ( msg Is Nothing ) Then Set msg = Nothing
Set fldDraft = Nothing
MsgBox intCount & " messages sent" , vbInformation + vbOKOnly
End Sub
댓글