AccessでVBAスクリプトを作成して、数十個の電子メールを作成および自動入力しています。これまでスムーズなコーディングを行ってきましたが、私はOutlookが初めてです。 mailitemオブジェクトを作成した後、メールにデフォルトの署名を追加するにはどうすればよいですか?
これは、新しいメールを作成するときに自動的に追加されるデフォルトの署名です。
理想的には、ObjMail.GetDefaultSignature
だけを使用したいのですが、そのようなものが見つかりません。
現在、私は以下の関数を使用して(インターネット上で elsewhere を見つけました)、htmファイルの正確なパスとファイル名を参照しています。ただし、これは複数の人々によって使用され、デフォルトのhtm署名ファイルには別の名前が付けられる場合があります。したがって、これは機能しますが、理想的ではありません。
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
(getboiler(SigString = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt")
で呼び出されます)
JP(コメントを参照)のおかげで、デフォルトの署名が最初に表示されることに気付きましたが、HTMLBodyを使用してメールにテーブルを追加すると消えます。だから私の質問は今だと思う:デフォルトの署名を表示し、それでもHTMLテーブルを表示する方法は?
Sub X()
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Set OlApp = Outlook.Application
Set ObjMail = OlApp.CreateItem(olMailItem)
ObjMail.BodyFormat = olFormatHTML
ObjMail.Subject = "Subject goes here"
ObjMail.Recipients.Add "Email goes here"
ObjMail.HTMLBody = ObjMail.Body & "HTML Table goes here"
ObjMail.Display
End Sub
以下のコードは、Outlookメッセージを作成し、自動署名を保持します
Dim OApp As Object, OMail As Object, signature As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
signature = OMail.body
With OMail
'.To = "[email protected]"
'.Subject = "Type your email subject here"
'.Attachments.Add
.body = "Add body text here" & vbNewLine & signature
'.Send
End With
Set OMail = Nothing
Set OApp = Nothing
私の解決策は、 空の 最初にメッセージを送信し(デフォルトの署名を使用!)、目的のstrHTMLBody
を既存のHTMLBody
に挿入します。
PowerUserの状態のように、HTMLBodyの編集中に署名が消去される場合、ObjMail.HTMLBody
の内容をObjMail.Display
の直後の変数strTemp
に保存し、その後strTemp
を追加することを検討できます必要ではないはずです。
Sub X(strTo as string, strSubject as string, strHTMLBody as string)
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Set OlApp = Outlook.Application
Set ObjMail = OlApp.CreateItem(olMailItem)
ObjMail.To = strTo
ObjMail.Subject = strSubject
ObjMail.Display
'You now have the default signature within ObjMail.HTMLBody.
'Add this after adding strHTMLBody
ObjMail.HTMLBody = strHTMLBody & ObjMail.HTMLBody
'ObjMail.Send 'send immediately or
'ObjMail.close olSave 'save as draft
'Set OlApp = Nothing
End sub
Dim OutApp As Object, OutMail As Object, LogFile As String
Dim cell As Range, S As String, WMBody As String, lFile As Long
S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
WMBody = "<br>Hi All,<br><br>" & _
"Last line,<br><br>" & S 'Add the Signature to end of HTML Body
どうやってこれを達成するかを共有すると思った。定義変数の意味で正しいかどうかはあまりわかりませんが、小さくて読みやすいので、どちらが好きですか。
オブジェクトOutlook.Application OLE内の.HTMLBodyにWMBodyを添付します。
それが誰かを助けることを願っています。
ありがとう、ウェス。
Outlookは、MailItem.Display
(画面にメッセージを表示する)を呼び出すとき、またはMailItem.GetInspector
にアクセスするときに、新しい未変更メッセージに署名を追加します(その前に本文を変更しないでください)。プロパティ-返されたInspectorオブジェクトで何もする必要はありませんが、Outlookはメッセージ本文に署名を追加します。
署名が追加されたら、HTMLBody
プロパティを読み取り、設定しようとしているHTML文字列とマージします。 2つのHTML文字列を単純に連結することはできません-文字列をマージする必要があることに注意してください。例えば。 HTML本文の先頭に文字列を挿入する場合は、"<body"
部分文字列を探してから、次に出現する ">"を見つけます(属性を持つ<body>
要素を処理します)。次に、「>」の後にHTML文字列を挿入します。
Outlook Object Modelは署名をまったく公開しません。
一般的な注意事項として、署名の名前は IOlkAccountManager Extended MAPIインターフェイスを介してアクセス可能なアカウントプロファイルデータに保存されます。そのインターフェイスは拡張MAPIであるため、C++またはDelphiを使用してのみアクセスできます。 IOlkAccountManager
ボタンをクリックすると、インターフェイスとそのデータを OutlookSpy で確認できます。
署名名を取得したら、ファイルシステムからHTMLファイルを読み取ることができます(フォルダー名(英語の署名)はローカライズされていることに注意してください)。
署名に画像が含まれる場合は、添付ファイルとしてメッセージに追加する必要があり、src
属性を指すように署名/メッセージ本文の<img>
タグも調整する必要があることに注意してください画像が保存されているSignaturesフォルダーのサブフォルダーではなく、添付ファイルに。
署名HTMLファイルのHTMLスタイルをメッセージ自体のスタイルとマージすることもお客様の責任です。
Redemption を使用するオプションがある場合、その RDOAccount オブジェクト(VBAを含む任意の言語でアクセス可能)を使用できます。新しいメッセージ署名名は0x0016001F
プロパティに保存され、返信署名は0x0017001F
に保存されます。 RDOAccount .ReplySignature
およびNewSignature
プロパティも使用できます。
リデンプションは RDOSignature .ApplyTo
メソッドも公開します。このメソッドは RDOMail オブジェクトへのポインターを取得し、指定された場所に署名を挿入して画像を正しくマージしますおよびスタイル:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set Drafts = Session.GetDefaultFolder(olFolderDrafts)
set Msg = Drafts.Items.Add
Msg.To = "[email protected]"
Msg.Subject = "testing signatures"
Msg.HTMLBody = "<html><body>some <b>bold</b> message text</body></html>"
set Account = Session.Accounts.GetOrder(2).Item(1) 'first mail account
if Not (Account Is Nothing) Then
set Signature = Account.NewMessageSignature
if Not (Signature Is Nothing) Then
Signature.ApplyTo Msg, false 'apply at the bottom
End If
End If
Msg.Send
編集:2017年7月現在、Outlook 2016のMailItem.GetInspector
は署名を挿入しなくなりました。 MailItem.Display
のみが行います。
定期的なスケジュールでメッセージを送信する方法を探しながら、このアプローチを構築しました。作成したメッセージのInspectorプロパティを参照するアプローチでは、必要な署名が追加されませんでした(Outlookに複数のアカウントを個別の署名で設定しています)。
以下のアプローチはかなり柔軟であり、まだシンプルです。
Private Sub Add_Signature(ByVal addy as String, ByVal subj as String, ByVal body as String)
Dim oMsg As MailItem
Set oMsg = Application.CreateItem(olMailItem)
oMsg.To = addy
oMsg.Subject = subj
oMsg.Body = body
Dim sig As String
' Mysig is the name you gave your signature in the OL Options dialog
sig = ReadSignature("Mysig.htm")
oMsg.HTMLBody = Item.Body & "<p><BR/><BR/></p>" & sig ' oMsg.HTMLBody
oMsg.Send
Set oMsg = Nothing
End Sub
Private Function ReadSignature(sigName As String) As String
Dim oFSO, oTextStream, oSig As Object
Dim appDataDir, sig, sigPath, fileName As String
appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
sigPath = appDataDir & "\" & sigName
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextStream = oFSO.OpenTextFile(sigPath)
sig = oTextStream.ReadAll
' fix relative references to images, etc. in sig
' by making them absolute paths, OL will find the image
fileName = Replace(sigName, ".htm", "") & "_files/"
sig = Replace(sig, fileName, appDataDir & "\" & fileName)
ReadSignature = sig
End Function
方法を見つけましたが、ほとんどの人にとってはあまりにもずさんすぎるかもしれません。シンプルなDbを持っているので、メールを生成できるようにしたいので、ここで使用したダウンした汚いソリューションを次に示します。
本文の先頭が新しいメールのHTMLBodyで「<div class=WordSection1>
」を見る唯一の場所であることがわかったので、単純な置換、置換を行いました
「<div class=WordSection1><p class=MsoNormal><o:p>
」
と
"<div class=WordSection1><p class=MsoNormal><o:p>" & sBody
ここで、sBodyは挿入する本文コンテンツです。これまでのところ動作しているようです。
.HTMLBody = Replace(oEmail.HTMLBody, "<div class=WordSection1><p class=MsoNormal><o:p>", "<div class=WordSection1><p class=MsoNormal><o:p>" & sBody)
PowerUserの調査と以前のコメントの助けなしには作成できなかったため、これをコミュニティWikiの回答にしました。
PowerUserのSub X
を取得して追加しました
Debug.Print "n------" 'with different values for n
Debug.Print ObjMail.HTMLBody
すべてのステートメントの後。このことから、署名が.HTMLBody
内にないのはObjMail.Display
の後までであり、本文に何も追加していない場合のみです。
C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt")
を使用したPowerUserの以前のソリューションに戻りました。 PowerUserはこれに不満を抱いていました。なぜなら、彼は自分のソリューションが異なる署名を持つ他の人のために働くことを望んでいたからです。
私の署名は同じフォルダーにあり、このフォルダーを変更するオプションが見つかりません。署名が1つしかないため、このフォルダー内の唯一のHTMファイルを読み取ることで、唯一の署名またはデフォルトの署名を取得しました。
HTMLテーブルを作成し、それを<body>要素の直後の署名に挿入し、html本文を結果に設定しました。私は自分にメールを送信しましたが、結果は完全に受け入れられました。
私の修正されたサブルーチンは次のとおりです。
Sub X()
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Dim BodyHtml As String
Dim DirSig As String
Dim FileNameHTMSig As String
Dim Pos1 As Long
Dim Pos2 As Long
Dim SigHtm As String
DirSig = "C:\Users\" & Environ("username") & _
"\AppData\Roaming\Microsoft\Signatures"
FileNameHTMSig = Dir$(DirSig & "\*.htm")
' Code to handle there being no htm signature or there being more than one
SigHtm = GetBoiler(DirSig & "\" & FileNameHTMSig)
Pos1 = InStr(1, LCase(SigHtm), "<body")
' Code to handle there being no body
Pos2 = InStr(Pos1, LCase(SigHtm), ">")
' Code to handle there being no closing > for the body element
BodyHtml = "<table border=0 width=""100%"" style=""Color: #0000FF""" & _
" bgColor=#F0F0F0><tr><td align= ""center"">HTML table</td>" & _
"</tr></table><br>"
BodyHtml = Mid(SigHtm, 1, Pos2 + 1) & BodyHtml & Mid(SigHtm, Pos2 + 2)
Set OlApp = Outlook.Application
Set ObjMail = OlApp.CreateItem(olMailItem)
ObjMail.BodyFormat = olFormatHTML
ObjMail.Subject = "Subject goes here"
ObjMail.Recipients.Add "my email address"
ObjMail.Display
End Sub
PowerUserと私は両方ともC:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures
に署名を見つけたので、これがOutlookインストールの標準の場所であることをお勧めします。このデフォルトは変更できますか?提案できるものが見つかりません。上記のコードは明らかに開発が必要ですが、署名の上にHTMLテーブルを含む電子メール本文を作成するというPowerUserの目的を達成します。
他のほとんどの答えは、HTML本体とHTML署名を単純に連結したものです。ただし、これは画像では機能せず、これを行うためのより「標準的な」方法があることがわかります。 1
WordEditorをエディターとして構成されたMicrosoft Outlook pre-2007、およびMicrosoft Outlook 2007以降では、Word Editorのわずかに縮小されたバージョンを使用してメールを編集します。これは、Microsoft Wordドキュメントオブジェクトモデルを使用して、電子メールに変更を加えることができることを意味します。
Set objMsg = Application.CreateItem(olMailItem)
objMsg.GetInspector.Display 'Displaying an empty email will populate the default signature
Set objSigDoc = objMsg.GetInspector.WordEditor
Set objSel = objSigDoc.Windows(1).Selection
With objSel
.Collapse wdCollapseStart
.MoveEnd WdUnits.wdStory, 1
.Copy 'This will copy the signature
End With
objMsg.HTMLBody = "<p>OUR HTML STUFF HERE</p>"
With objSel
.Move WdUnits.wdStory, 1 'Move to the end of our new message
.PasteAndFormat wdFormatOriginalFormatting 'Paste the copied signature
End With
'I am not a VB programmer, wrote this originally in another language so if it does not
'compile it is because this is my first VB method :P
Microsoft Outlook 2007プログラミング(S. Mosher)>第17章、アイテムボディの操作:Outlook署名の操作
最も役立つと思われる署名オプションに対してコメントを投稿するには50人の担当者が必要ですが、画像が正しく表示されないという問題があったため、回避策を見つける必要がありました。これは私の解決策です:
@Morris Maynardの回答をベースとして使用 https://stackoverflow.com/a/18455148/2337102 その後、次の手順を実行する必要がありました。
注:
。htmファイルをバックアップしてから開始し、セカンダリフォルダーにコピーして貼り付けます
SignatureName.htm
とSignatureName_files Folder
の両方で作業します
HTML
の経験は必要ありません。ファイルはNotepadやNotepad ++などの編集プログラム、または指定したHTMLプログラムで開きます
署名ファイルの場所に移動します(標準はC:\Users\"username"\AppData\Roaming\Microsoft\Signatures
である必要があります)
SignatureName.htm
ファイルをtext/htmエディターで開きます(「プログラムで編集」ファイルを右クリックします)
Ctrl+F
を使用して.png
を入力します。 .jpg
または画像タイプがわからない場合は、image001
を使用します。次のようなものが表示されます:src="signaturename_files/image001.png"
これを画像の場所のアドレス全体に変更する必要がありますC:\Users\YourName\AppData\Roaming\Microsoft\Signatures\SignatureNameFolder_files\image001
またはsrc="E:\location\Signatures\SignatureNameFolder_files\image001.png"
ファイルを保存します(上書きします。もちろん元のファイルをバックアップしていました)
Outlookに戻り、新しいメールアイテムを開き、署名を追加します。ファイルが変更されたという警告が表示されたので、[OK]をクリックしました。これを2回実行し、[署名の編集]メニューで1回実行する必要がありました。
Some of the files in this webpage aren't in the expected location. Do you want to download them anyway? If you're sure the Web page is from a trusted source, click Yes."
マクロイベントを実行すると、画像が表示されます。
クレジット
MrExcel-VBAコード署名コードエラー: http://bit.ly/1gap9jY
Mozzi の答えは好きですが、ユーザー固有のデフォルトのフォントを保持していないことがわかりました。テキストはすべて、通常のテキストとしてシステムフォントに表示されます。以下のコードは、ユーザーのお気に入りのフォントを保持しながら、もう少しだけ長くしています。 Mozzi のアプローチに基づいており、正規表現を使用してデフォルトの本文テキストを置き換え、GetInspector.WordEditorを使用して、ユーザーが選択した本文テキストを所属する場所に配置します。 GetInspectorの呼び出しがnotでした- dimitry streblechenko がこのスレッドで、少なくとも、 Office 2010では、オブジェクトは引き続きコードに表示されます。ちなみに、MailItemは単純なMailItemとしてではなく、Objectとして作成することが重要であることに注意してください-詳細については here を参照してください。 (ああ、好みの異なる人には申し訳ありませんが、ルーチンを見つけられるように、より長い説明的な変数名を好みます!)
Public Function GetSignedMailItemAsObject(ByVal ToAddress As String, _
ByVal Subject As String, _
ByVal Body As String, _
SignatureName As String) As Object
'================================================================================================================='Creates a new MailItem in HTML format as an Object.
'Body, if provided, replaces all text in the default message.
'A Signature is appended at the end of the message.
'If SignatureName is invalid any existing default signature is left in place.
'=================================================================================================================
' REQUIRED REFERENCES
' VBScript regular expressions (5.5)
' Microsoft Scripting Runtime
'=================================================================================================================
Dim OlM As Object 'Do not define this as Outlook.MailItem. If you do, some things will work and some won't (i.e. SendUsingAccount)
Dim Signature As String
Dim Doc As Word.Document
Dim Regex As New VBScript_RegExp_55.RegExp '(can also use use Object if VBScript is not Referenced)
Set OlM = Application.CreateItem(olMailItem)
With OlM
.To = ToAddress
.Subject = Subject
'SignatureName is the exactname that you gave your signature in the Message>Insert>Signature Dialog
Signature = GetSignature(SignatureName)
If Signature <> vbNullString Then
' Should really strip the terminal </body tag out of signature by removing all characters from the start of the tag
' but Outlook seems to handle this OK if you don't bother.
.Display 'Needed. Without it, there is no existing HTMLbody available to work with.
Set Doc = OlM.GetInspector.WordEditor 'Get any existing body with the WordEditor and delete all of it
Doc.Range(Doc.Content.Start, Doc.Content.End) = vbNullString 'Delete all existing content - we don't want any default signature
'Preserve all local email formatting by placing any new body text, followed by the Signature, into the empty HTMLbody.
With Regex
.IgnoreCase = True 'Case insensitive
.Global = False 'Regex finds only the first match
.MultiLine = True 'In case there are stray EndOfLines (there shouldn't be in HTML but Word exports of HTML can be dire)
.Pattern = "(<body.*)(?=<\/body)" 'Look for the whole HTMLbody but do NOT include the terminal </body tag in the value returned
OlM.HTMLbody = .Replace(OlM.HTMLbody, "$1" & Signature)
End With ' Regex
Doc.Range(Doc.Content.Start, Doc.Content.Start) = Body 'Place the required Body before the signature (it will get the default style)
.Close olSave 'Close the Displayed MailItem (actually Object) and Save it. If it is left open some later updates may fail.
End If ' Signature <> vbNullString
End With ' OlM
Set GetSignedMailItemAsObject = OlM
End Function
Private Function GetSignature(sigName As String) As String
Dim oTextStream As Scripting.TextStream
Dim oSig As Object
Dim appDataDir, Signature, sigPath, fileName As String
Dim FileSys As Scripting.FileSystemObject 'Requires Microsoft Scripting Runtime to be available
appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
sigPath = appDataDir & "\" & sigName & ".htm"
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set oTextStream = FileSys.OpenTextFile(sigPath)
Signature = oTextStream.ReadAll
' fix relative references to images, etc. in Signature
' by making them absolute paths, OL will find the image
fileName = Replace(sigName, ".htm", "") & "_files/"
Signature = Replace(Signature, fileName, appDataDir & "\" & fileName)
GetSignature = Signature
End Function
多くの場合、この質問はRon de BruinのRangeToHTML
関数のコンテキストで行われます。この関数は、Excel.Range
からHTML PublishObject
を作成し、FSOを介してそれを抽出し、結果のストリームHTMLをメールのHTMLBody
。そうすることで、これはデフォルトの署名を削除します(RangeToHTML
関数には、デフォルトの署名を挿入しようとするヘルパー関数GetBoiler
があります)。
残念ながら、文書化が不十分なApplication.CommandBars
メソッドはOutlook経由では利用できません。
wdDoc.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
ランタイム6158が発生します。
ただし、Word.Document
メソッドを介してアクセス可能なMailItem.GetInspector
を引き続き利用できます。このようなことを行うと、ExcelからOutlookの電子メール本文に選択範囲をコピーして貼り付けることができます。 1であります)。
Dim rng as Range
Set rng = Range("A1:F10") 'Modify as needed
With OutMail
.To = "[email protected]"
.BCC = ""
.Subject = "Subject"
.Display
Dim wdDoc As Object '## Word.Document
Dim wdRange As Object '## Word.Range
Set wdDoc = OutMail.GetInspector.WordEditor
Set wdRange = wdDoc.Range(0, 0)
wdRange.InsertAfter vbCrLf & vbCrLf
'Copy the range in-place
rng.Copy
wdRange.Paste
End With
場合によっては列の幅や行の高さを完全に保持できない場合があります。また、Excel範囲内の図形やその他のオブジェクトもコピーしますが、これによりファンキーな配置の問題が発生する場合がありますが、 Excelの範囲、それは非常に良いです: