2016-05-19 8 views
0

私のVBAの経験は非常に限られています。私はオンラインで一緒に見つける複数のマクロを主にフランケンシュタインすることによって、オープンドラフト(または選択された電子メール)はBCC、件名、および送信を追加します

ここで私は何をしようとしています。毎朝、200人の顧客のリストに電子メールを送り、リストから新しいメッセージを開き、メッセージが自動的に(署名のように)入力されます。現在私はこれらすべての電子メールを通過し、私の件名とBCCを追加します。これらのメールをすべて開き、BCCを追加し、件名を追加してメールを送信するためのマクロを作成することもできます。

何かすべてのヘルプは大歓迎です。

答えて

1

次のコードは、のインスタンスを定義し、送信準備が整ったMailItemを設定します。これは、電子メールと呼ばれるDictionaryオブジェクトを使用してTo、BCCなどのデータを埋め込むためのさまざまな情報を保持しますが、それらは自分の文字列などで置き換えることができます。これを私が書いた関数から引っ張り出して少し一般的にしました:

Public Function OL_SendMail() 
Dim bOpenedOutlook, sComputer, iLoop, iAccount, sAttachArray, sAttachment 
     bOpenedOutlook = False 
     sComputer = "." 
     Dim oWMIService : Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2") 
     Dim colItems : Set colItems = oWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'outlook.exe'") 
     Dim oOutlook : Set oOutlook = CreateObject("Outlook.Application") 
     Dim oNamespace : Set oNamespace = oOutlook.GetNamespace("MAPI") 
     If colItems.Count = 0 Then 
      ' Outlook isn't open, logging onto it... 
      oNamespace.Logon "Outlook",,False,True 
      bOpenedOutlook = True 
     End If 
     Dim oFolder : Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox) 

    If EmailData("SendFrom") = "" Then 
     ' default to first email account the user has access to 
     iAccount = 1 
    Else 
     ' Checking to see if the account to send from is accessible by this user... 
     iAccount = 0 
     For iLoop = 1 To oOutlook.Session.Accounts.Count 
      If UCase(Trim(oOutlook.Session.Accounts.Item(iLoop))) = UCase(Trim(EmailData("SendFrom"))) Then 
       iAccount = iLoop 
       Exit For 
      End If 
     Next 
     If iAccount = 0 Then 
      sErrorMsg = "Cannot send email from specified account: " & EmailData("SendFrom") & " as this user doesn't appear to have access to it in Outlook!" 
      OL_SendMail = False 
      Exit Function 
     End If 
    End If 

    Dim oMailItem : Set oMailItem = oOutlook.CreateItem(olMailItem) 
    With oMailItem 
     Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount) 
     .To = EmailData("To") 
     .CC = EmailData("CC") 
     .BCC = EmailData("BCC") 
     .Subject = EmailData("Subject") 
     .Body = EmailData("Body") 
     sAttachArray = Split(EmailData("AttachmentPaths"), ";") 
     For Each sAttachment In sAttachArray 
      .Attachments.Add(sAttachment) 
     Next 
     .Recipients.ResolveAll 
     .Display ' debug mode - uncomment this to see email before it's sent out 
    End With 


'Mail Item created and ready to send 
    'oMailItem.Send ' this is commented out so the mail doesn't auto send, allows checking of it!! 
    Set oMailItem = Nothing 
    Set oNamespace = Nothing 
    If bOpenedOutlook Then 
     'oOutlook.Quit 
    End If 
    Set oOutlook = Nothing 
    Set colItems = Nothing 
    Set oWMIService = Nothing 

    OL_SendMail = True 
End Function 
関連する問題