AccessとOutlookの便利な連携術
脱メールとは言え、企業の情シスが規制しているが為に業務改善を行いたくても、各種REST APIが利用できなくされていたり、また外部のウェブサービスを利用させてもらえず、そこで停滞したまま効率化されずにいる日本企業は非常に多いです。
しかし、メールは原始的なコミュニケーション手段であり、埋もれる、取りこぼす、調べるのに莫大な時間を要する、また個人宛なので過去の経緯などが次の人に引き継がれず、また活用するにしてもノイズが多く使いづらいです。そこでAccessと連携させる事で、必要なメール情報だけを取り込んで、データ化する事で、利便性が向上します。
リンク
目次
今回使用するファイル類
リンクテーブルを利用する
手動でリンクテーブルにて接続
あまり知られていない機能ですが、Accessは標準でOutlookの受信トレイなどにリンクテーブルを簡単に貼る事が可能です。受信トレイ以外にもリンクテーブルを貼る事はもちろん可能。共有メールボックスや連絡先などにも接続できたりするので、色々と応用が利くと思います。接続手順は以下の通り。
- Accessメニューの外部データを開き、新しいデータソース⇒他のソースから⇒Outlookフォルダを選択
- ダイアログが出るので、「リンクテーブルを作成してソースデータにリンクする」にチェックをいれて、次へ進む
- どのフォルダにリンクするか？を選んで、次へをクリック。今回は受信トレイを選択。
- リンクするテーブル名を設定して完了をクリックするとリンクテーブルとしてOutlookのフォルダが表示される
- あとは、普通のテーブルと同様に中に表示されたデータを取り出しす事が可能。ただし、追加することはできません。
リンクしたテーブルを見てみるとかなり細かくデータが入ってることがわかります。いくつか気になる点としては
- Microsoft365のExchange Serverを利用してる場合、メールアドレスがなく特殊な形式になってる（外部の人の場合はメールアドレスはしっかり入ってる）
- 本来あるはずの各メールのユニークなID（EntryIDやMessageID）などは無い。よって、そのメールに返信したかどうかの判定はメールタイトルなどから判断しなければならない（ぶら下がり先がわからない為）
- 本人宛やCC、TOなどはわかるが、BCCについては表示がない
- 添付ファイルなどはその有無はフラグでわかるが、データとしてはテーブルから取ることは出来ない
- 共有メールボックスの一部はリンクできないケースもある
- メールボックスのメール数が多いとリンクテーブルの場合非常に動作が遅くなる。
図：受信トレイと直接接続してみた
図：Teamsの会話やタスクなども接続可能みたい
VBAで動的にリンクテーブルを作る
プログラムとして配布し利用してもらうにあたっては、上記の手動でリンクテーブル貼ってもらうというのは正直ちょっとスマートな方法ではありません。しかし、リンクテーブルは人によってリンク先のパスが異なる（Outlookの場合、C:Usersユーザ名AppDataLocalTempが接続先なので、ここがネックになる）
そこでVBAにて自動でワンクリックでリンクテーブルを貼れるようにしておくと良いでしょう。ODBCリンクテーブルと同じような要領で貼る事が可能です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
'Outlookの受信トレイと自動で接続する Public Function getInboxFolder() 'ログインユーザ名を取得する Dim WshNetworkObject As Object Set WshNetworkObject = CreateObject("WScript.Network") Dim userid As String userid = WshNetworkObject.username '接続先メールアカウント '共有メールボックスの場合はメールアドレスではなくアカウント名を利用する Dim mailman As String Set OL = CreateObject("Outlook.Application") Dim olNS As Outlook.NameSpace Dim olFol As Outlook.Folder Set olNS = OL.GetNamespace("MAPI") Set olFol = olNS.GetDefaultFolder(olFolderInbox) mailman = olNS.Accounts.Item(1).SmtpAddress 'デフォルトのメールアカウントを今回は使用 'リンクテーブル用変数 Dim db As DAO.Database Dim td As DAO.TableDef Set db = CurrentDb Set td = db.CreateTableDef("tblInbox") '接続文字列 Dim inboxman As String inboxman = "Outlook 9.0;MAPILEVEL=" & mailman & "|;PROFILE=Outlook;TABLETYPE=0;TABLENAME=Inbox;COLSETVERSION=12.0;DATABASE=C:Users" & userid & "AppDataLocalTemp" '接続する td.Connect = inboxman td.SourceTableName = "受信トレイ" db.TableDefs.Append td Application.RefreshDatabaseWindow '終了処理 db.Close Set db = Nothing Set td = Nothing Set WshNetworkObject = Nothing End Function |
- 本コードを使うには、参照設定にてMicrosoft Outlook 1x.0 Object Libraryを加えておく必要があります。
- WScriptを利用してログインユーザ名を取得させています。
- 今回はtblInboxという名前でリンクテーブルを作成しています。
- 接続文字列がODBCとは違いちょっと特殊です。この時、ログインユーザ名を利用してパスを組み立て、また予めどのアカウントなのか区別するため、mailmanにメールアドレスを入れておく必要があります。
- 今回は受信トレイが対象なので、td.SouceTableNameには受信トレイを入れておきます。
- デフォルトのその人のアカウント名を今回は自動で取得。olNS.Accounts.Item(1).SmtpAddressで実現していますが、複数アカウントがある場合にはItemの引数の番号を変更すれば良い。またはFor Eachで回して取得するのも良いでしょう。
- 起動時に自動でリンクテーブルを作り直すように、Autoexecマクロを利用して、リンクテーブル削除と組み直しを自動実行しておくと尚良いでしょう。
VBAからOutlookを操作する
VBAとOutlookの参照設定にて、リンクテーブルよりも多くのメール情報をレコードとして取得し格納する事が可能です。ただし、この方法でも「Message-ID」や「In-Reply-To」などの固有のIDや返信先のIDなどは取得が出来ない。EntryIDというIDが各メールに割り振られているものの、このIDは不変ではなく、フォルダを移動したりすると変更されてしまうので、扱いに注意が必要です。
通常のメールボックスメールを取得する
通常の自分自身のメールボックスのメールを取得します。受信フォルダ以下に作成したサブフォルダに対して取得を実行する事も可能です。この手法の場合、共有メールボックスのメールは取得できないので注意が必要です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
'指定アカウントのOutlook受信トレイ内のメールをテーブルに取得する (日付の最大値以上のものだけを取得) Public Function getOutlookMail() Dim result As Variant result = MsgBox("Outlookから最新のデータを取得しますか？？件数が多いと相当の時間が掛かります。", vbYesNo + vbDefaultButton2 + vbExclamation) If result = vbYes Then 'そのまま次の処理へ移動する Else MsgBox "処理がキャンセルされました。" Exit Function End If 'Outlook用変数 Dim objOutlook As Outlook.Application Dim olNS As Outlook.NameSpace Set objOutlook = New Outlook.Application Set olNS = objOutlook.GetNamespace("MAPI") 'アカウント名を取得する Dim mailman As String mailman = olNS.Accounts.Item(1).SmtpAddress '受信トレイを取得する Set myInbox = olNS.GetDefaultFolder(olFolderInbox) 'サブフォルダを指定したい場合は以下のコードを追加し、subfolderでItems.CountをForで回す 'Dim subfolder 'Set subfolder = myInbox.Folders.Item("サブフォルダ名") 'DB接続用 Dim db As DAO.Database Set db = CurrentDb() Dim rs As DAO.Recordset Set rs = db.OpenRecordset("受信トレイ", dbOpenDynaset) '受信トレイのレコードのsenddateの最大日付を取得する Dim maxdate As Variant maxdate = DMax("senddate", "受信トレイ") If IsNull(maxdate) Then maxdate = 0 End If '受信トレイ内を探索 Dim i As Long Dim tempdate As Variant Dim diffman As Variant For i = 1 To myInbox.Items.Count '受信日付を取得する tempdate = myInbox.Items(i).ReceivedTime 'DMaxの値によって条件分岐 If maxdate = 0 Then '特に何もしない Else '受信日付を取得する 'DMaxの値とsenddateの値を比較 '差分を取る diffman = DateDiff("s", maxdate, tempdate) '最大日付のレコードより過去のデータはスキップする If diffman <= 0 Then GoTo Continue End If End If 'レコードを追加する With rs .AddNew '受信データを書き込む On Error Resume Next !EntryID = myInbox.Items(i).EntryID !senddate = tempdate !Subject = myInbox.Items(i).Subject !Body = myInbox.Items(i).Body !Sender = myInbox.Items(i).Sender !CC = myInbox.Items(i).CC !To = myInbox.Items(i).To .Update End With Continue: Next i '終了処理 MsgBox "取込が完了しました。" db.Close Set db = Nothing Set rs = Nothing End Function |
- 6000通のメールでおよそ5分ほど掛かります。
- リンクテーブルではないので、受信後データの表示や処理は高速に行えます。
- 日付時刻を見て現在取得済みメールの最大値より大きい値（つまり未来のメール）だけを取得して追加するようにしてあります。DMaxで最大値を取得し、DateDiffの秒での比較で0よりプラスの値がそれになります。
- 各メールのItemのプロパティは様々なものが用意されています。こちらのページのPropertiesがそれに該当します。
- 稀にSenderに値のないものがあってコードが止まるケースの為に、on error resume nextを入れてあります。
- 指定のメールアドレスの取得はmailman変数に格納し、.Session.CreateRecipientにてセットする
- 共有メールボックスからのメール取得は出来ません
- .GetDefaultFolderの第二引数では、olFolderInboxを指定すると受信トレイになります。こちらにいろいろなフォルダの指定用の値が一覧で表示されています。
- 受信トレイ以下に作成したサブフォルダを対象にしたい場合にはsubfolderをFolders.Itemにて指定し、それをループで回せばOK
- 今回のコードは使ってるOutlookでのデフォルトアカウントが１個だけの場合です。
Outlookに複数のアカウントがある場合には以下のようなアカウントの特定とGetDefaultFolderの指定はアカウントをループして特定してセットすると良いです。以下のようなコードに置き換えます。このとき指定のメアドに自分の２つ目のメアドを入れて判定させます。
|
1 2 3 4 5 6 7 8 9 |
'複数アカウントがある場合の処理 Dim oAccount As Account With objOutlook For Each oAccount In olNS.Accounts If oAccount = "指定のメアド" Then Set myInbox = acc.DeliveryStore.GetDefaultFolder(olFolderInbox) End If Next End With |
また、手動でアカウントと指定のフォルダ内を取得したい場合には以下のような決め打ちも可能です。指定アカウントの受信フォルダ以下に作成した指定のフォルダ内を走査します。
|
1 2 3 4 5 |
For Each itms1 In olNS.Folders("アカウント名").Folders("受信トレイ").Folders("フォルダ名").Items ・・・・ここにデータを取得する処理を記述する・・・・ Next |
共有メールボックスメールを取得する
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
'指定アカウントのOutlook受信トレイ内のメールをテーブルに取得する（日付の最大値以上のものだけを取得） Public Function getShareOutlookMail() Dim result As Variant result = MsgBox("Outlookから最新のデータを取得しますか？？件数が多いと相当の時間が掛かります。", vbYesNo + vbDefaultButton2 + vbExclamation) If result = vbYes Then 'そのまま次の処理へ移動する Else MsgBox "処理がキャンセルされました。" Exit Function End If 'outlook用変数 Dim objOutlook As Object Dim myInbox Dim acc As Object Set objOutlook = GetObject(, "Outlook.Application") Dim olNS As Outlook.NameSpace Set olNS = objOutlook.GetNamespace("MAPI") 'アカウント名を取得する Dim mailman As String mailman = "ここに共有メールボックスのメアドを入れる" '指定のアカウントのNamespaceを取得 With objOutlook Set acc = .Session.CreateRecipient(mailman) acc.Resolve If acc.Resolved Then '受信トレイを指定 Set myInbox = .Session.GetSharedDefaultFolder(acc, olFolderInbox) End If End With 'DB接続用 Dim db As DAO.Database Set db = CurrentDb() Dim rs As DAO.Recordset Set rs = db.OpenRecordset("受信トレイ", dbOpenDynaset) '受信トレイのレコードのsenddateの最大日付を取得する Dim maxdate As Variant maxdate = DMax("senddate", "受信トレイ") If IsNull(maxdate) Then maxdate = 0 End If '受信トレイ内を探索 Dim i As Long Dim tempdate As Variant Dim diffman As Variant For i = 1 To myInbox.Items.Count '受信日付を取得する tempdate = myInbox.Items(i).ReceivedTime 'DMaxの値によって条件分岐 If maxdate = 0 Then '特に何もしない Else '受信日付を取得する 'DMaxの値とsenddateの値を比較 '差分を取る diffman = DateDiff("s", maxdate, tempdate) '最大日付のレコードより過去のデータはスキップする If diffman <= 0 Then GoTo Continue End If End If 'レコードを追加する With rs .AddNew '受信データを書き込む On Error Resume Next !EntryID = myInbox.Items(i).EntryID !senddate = tempdate !Subject = myInbox.Items(i).Subject !Body = myInbox.Items(i).Body !Sender = myInbox.Items(i).Sender !CC = myInbox.Items(i).CC !To = myInbox.Items(i).To .Update End With Continue: Next i '終了処理 MsgBox "取込が完了しました。" db.Close Set db = Nothing Set rs = Nothing End Function |
- 指定のメールアドレスの取得はmailman変数に格納し、.Session.CreateRecipientにてセットする
- 共有メールボックスからのメール取得では、.Session.GetSharedDefaultFolderを使って取得します。
- .Session.GetSharedDefaultFolderの第二引数では、olFolderInboxを指定すると受信トレイになります。こちらにいろいろなフォルダの指定用の値が一覧で表示されています。ただし、olFolderSentMailなどの送信済みトレイなどの指定が出来ません。
- 日付時刻を見て現在取得済みメールの最大値より大きい値（つまり未来のメール）だけを取得して追加するようにしてあります。DMaxで最大値を取得し、DateDiffの秒での比較で0よりプラスの値がそれになります。
- 各メールのItemのプロパティは様々なものが用意されています。こちらのページのPropertiesがそれに該当します。
- 稀にSenderに値のないものがあってコードが止まるケースの為に、on error resume nextを入れてあります。
- こちらの手法は共有メールボックスも扱えますが、取得の速度がかなり遅いので時間を要します。
共有メールボックスで送信済みトレイデータを取得する
前項の方法では、受信トレイデータは取れても、例えば送信済みトレイを取る事ができません。.GetSharedDefaultFolderの引数にolFolderSentMailを指定することが出来ないためです。そこで、一旦受信トレイを取得し、その親に移動、そこから送信済みトレイと辿る事で取得することが可能になります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 |
'指定アカウントのOutlook送信済みトレイ内のメールをテーブルに取得する（日付の最大値以上のものだけを取得） Public Function getOutlookMail() Dim result As Variant result = MsgBox("Outlookから最新のデータを取得しますか？？件数が多いと相当の時間が掛かります。", vbYesNo + vbDefaultButton2 + vbExclamation) If result = vbYes Then 'そのまま次の処理へ移動する Else MsgBox "処理がキャンセルされました。" Exit Function End If 'outlook用変数 Dim objOutlook As Object Dim myInbox Dim acc As Object Set objOutlook = GetObject(, "Outlook.Application") 'Namespaceを取得する Dim olNS As Outlook.NameSpace Set olNS = objOutlook.GetNamespace("MAPI") 'アカウント名を取得する Dim mailman As String mailman = IniRead("USER", "OUTLOOK", "") '指定のアカウントのNamespaceを取得 With objOutlook Set acc = .Session.CreateRecipient(mailman) acc.Resolve If acc.Resolved Then Set myInbox = olNS.GetSharedDefaultFolder(acc,olFolderInbox).Parent.Folders("送信済みアイテム") End If End With 'DB接続用 Dim db As DAO.Database Set db = CurrentDb() Dim rs As DAO.Recordset Set rs = db.OpenRecordset("送信済みトレイ", dbOpenDynaset) '受信トレイのレコードのsenddateの最大日付を取得する maxdate = DMax("senddate", "送信済みトレイ") If IsNull(maxdate) Then maxdate = 0 End If '送信済みトレイ内を探索 For i = 1 To myInbox.Items.Count '受信日付を取得する tempdate = myInbox.Items(i).ReceivedTime 'DMaxの値によって条件分岐 If maxdate = 0 Then '特に何もしない Else '受信日付を取得する 'DMaxの値とsenddateの値を比較 '差分を取る diffman = DateDiff("s", maxdate, tempdate) '最大日付のレコードより過去のデータはスキップする If diffman <= 0 Then GoTo Continue2 End If End If 'レコードを追加する With rs .AddNew '受信データを書き込む !entryid = myInbox.Items(i).entryid !senddate = tempdate !subject = myInbox.Items(i).subject !body = myInbox.Items(i).body !sender = myInbox.Items(i).sender !cc = myInbox.Items(i).cc !to = myInbox.Items(i).to .Update End With Continue2: Next i '終了処理 MsgBox "取込が完了しました。" db.Close Set db = Nothing Set rs = Nothing End Function |
- 前回のコードに加えて、objOutlook.GetNamespace("MAPI")にてNamespaceを取得しておく
- 取得したNamespaceに対して、olNS.GetSharedDefaultFolder(acc,olFolderInbox).Parent.Folders("送信済みアイテム")にて受信トレイ⇒親フォルダ⇒送信済みアイテムと辿ってフォルダを取得させる
- あとはこれまでと同じようにループで一個ずつ取り出す。
- この方法だと、どこかにぶら下がっているわけではないフォルダの中身も正確に取り出すことが可能です。
共有メールボックスにてメールを新規送信
通常のメールボックスでももちろんメールを送信できますが、共有メールボックスアカウントを使ってのメール送信はやや面倒です。別途メール作成用のフォームなどは用意しておく必要性があります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
Private Sub コマンド25_Click() '通常の変数の宣言 Dim result As Variant '処理実行の確認 result = MsgBox("上記の内容で、メールを送信しますか？。", vbYesNo + vbDefaultButton2 + vbCritical, "新規メールの送信") If result = vbYes Then Else '処理のキャンセル MsgBox "処理はキャンセルされました。" Exit Sub End If 'Outlook用変数 Dim olkApp, objItem, acctToSend Dim oAccount As Outlook.Account Set olkApp = CreateObject("Outlook.Application") 'メールアイテムを作成 Set objItem = olkApp.CreateItem(0) '宛先、件名、本文を指定 'メアドはカンマはセミコロンに置き換えておく With objItem .to = Replace(Me.tomail.value, ",", ";") .cc = Replace(Me.ccmail.value, ",", ";") .subject = Me.subject.value .body = Me.body.value End With '送信アカウントを取得 Dim mailacc As String mailacc = "ここに共有メールボックスのメアドを入れる" ' 送信アカウントを指定 'Session.Accounts.Item()だと()に番号をいれなければならない。アカウント名だとNG objItem.SentOnBehalfOfName = mailacc 'メールを送信 objItem.send '終了処理 MsgBox "メール送信されました。" Set olkApp = Nothing Set objItem = Nothing Set acctToSend = Nothing 'ダイアログを閉じる DoCmd.Close acForm, "新規メール作成", acSaveNo End Sub |
- CreateItem(0)にて新規のメール作成になります。
- toやccは、複数宛先がある場合、旧式のカンマを入れてしまった場合に備えて、セミコロンにリプレースしています。
- 送信するアカウントはデフォルトだと自分のアカウントを使ってしまうので、SentOnBehalfOfNameを使って送信アカウントを指定します。
図：新規メール作成用のサンプルフォームの事例
共有メールボックスにてメールを返信する
返信の場合は新規作成よりもさらにちょっと複雑です。あまりネットにも資料がないのですが、基本はreplyメソッドを使ってメールを作ることになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
Private Sub コマンド25_Click() '通常の変数の宣言 Dim result As Variant '処理実行の確認 result = MsgBox("上記の内容で、メールを返信しますか？。", vbYesNo + vbDefaultButton2 + vbCritical, "新規メールの送信") If result = vbYes Then Else '処理のキャンセル MsgBox "処理はキャンセルされました。" Exit Sub End If 'Outlook用変数 Dim olkApp, objItem, acctToSend Dim oAccount As Outlook.Account Set olkApp = GetObject(, "Outlook.Application") Set olNS = olkApp.GetNamespace("MAPI") Dim Mail, NewMail, acc '送信アカウントを取得 Dim mailman As String mailacc = "ここに共有メールボックスのメアドを入れる" '指定のアカウントの受信トレイを取得し対象とする With olkApp Set acc = .Session.CreateRecipient(mailacc) acc.Resolve If acc.Resolved Then 'olFolderSentMailで送信済みフォルダ Set myInbox = .Session.GetSharedDefaultFolder(acc, olFolderInbox) End If End With 'mailにentryidをセットする Set Mail = olNS.GetItemFromID(Me.entryid.value) Set NewMail = Mail.Reply 'HTML Bodyにするために改行コードを<br>に変更 Dim bodyman As String bodyman = Replace(Me.body.value, vbCrLf, "<br>") '受信メール側bodyも置き換えておく Dim bodyman2 As String bodyman2 = Replace(Me.body2.value, vbCrLf, "<br>") '宛先、件名、本文を指定 With NewMail .to = Replace(Me.tomail.value, ",", ";") .cc = Replace(Me.ccmail.value, ",", ";") .subject = Me.subject.value .HTMLBody = bodyman & "<br><hr><br>" & bodyman2 .BodyFormat = olFormatHTML 'HTML形式で送信 .SentOnBehalfOfName = mailacc ' 送信アカウントを指定 End With 'メールを送信 NewMail.send '終了処理 MsgBox "メールが返信されました。" Set olkApp = Nothing Set Mail = Nothing Set NewMail = Nothing 'ダイアログを閉じる DoCmd.Close acForm, "返信メール作成", acSaveNo End Sub |
- 予め、メールの受信用テーブルに受信時に対象のメールの「entryID」を取得しておく必要があります。
- 共有メールボックスの受信トレイを取得しておく必要があるため、Session.GetSharedDefaultFolderで取得させておきます。
- GetItemFromIDとentryIDにて返信対象となるメールを取得しておきます。それにたいして、Replyを行う
- 今回はHTMLメールを送るために、返信元メール本文やフォーム上の内容の改行コードを<br>に置換させています。
- あとは通常の送信と同じように組み立ててsendするだけ
図：自分が作った返信用フォーム
作っておいた署名を取得する
OutlookメールをVBAで送る場合、署名が自動では入りません。Outlookに自分で設定済みの署名を取得し、メール本文に付け足したいケースはままあると思います。この署名ですが
- Outlookの新規メール作成⇒挿入⇒署名(▼クリック）⇒署名とすると出てくる
- 複数の署名を作っておくことが可能です。
- 作った署名は署名の名前.txtという形で、各ユーザのC:Usersユーザ名AppDataRoamingMicrosoftSignaturesのディレクトリに、署名名で作ったtxtという形でファイルとして保存されています。
これをVBAで取るならば事前に、Windows Script Host Object Modelを参照設定に入れて於いてユーザ名を自動取得させ、所定のディレクトリにアクセスさせましょう。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
Public Function readsign() 'FileSystemObject用変数 Dim fso As Object, buf As String Set fso = CreateObject("Scripting.FileSystemObject") 'ログインユーザ名を取得する Dim WshNetworkObject As IWshRuntimeLibrary.WshNetwork Set WshNetworkObject = New IWshRuntimeLibrary.WshNetwork dim loginuser as string loginuser = WshNetworkObject.UserName '署名ファイルのパスを構築する dim filepath as string dim signname as string singname = "署名" filepath = "C:Users" & loginuser & "AppDataRoamingMicrosoftSignatures" & singname & ".txt" '署名ファイルの中身を取得して返す With fso.GetFile(filepath).OpenAsTextStream(1, -2) buf = .ReadAll .Close End With '終了処理 Set fso = Nothing '署名データを返す readsign = buf End Function |
- ログインユーザ名を取得し、signnameに署名の名前を入れておく。
- パスを構築して、fsoにてtxtファイルの中身を取得し、返すだけの関数です
図：署名ファイルはtxtファイルで保存されている
関連リンク
- Can I modify Conversation ID in Outlook by VBA to group independent Emails?
- OlDefaultFolders enumeration (Outlook)
- Excel マクロからメールを送信する際に送信アカウントを指定する方法
- MailItem object (Outlook)
- VBA to select mailbox if an account has multiple mailbox's
- OUTLOOKの指定したアカウントの受信トレイ（またはその配下のフォルダ）からメールを読み込みたい
- send outlook email in nested view using excel vba
- How to send a same reply mail(template saved in outlook) to the mail sender(to,cc)
- Creating table of Outlook Inbox emails in Access
- Outlook VBA オブジェクト まとめ
- ユーザー名やコンピュータ名を取得する（WshNetworkオブジェクト）
- MS Access / Outlook 2010 - how to choose which account to send email from?
- How to get the email address of the current logged-in user?
- Outlookの返信でSendUsingAccountを設定するVBAコード - vba、outlook
- 共有メールフォルダ取得で エラー -2147221233：実行しようとした操作が失敗しました。オブジェクトが見つかりませんでした。
- 複数アカウントが設定されているプロファイルのメイン以外のアカウントの予定表を取得する方法
- Excel マクロからメールを送信する際に送信アカウントを指定する方法
- Outlookの返信メールを作成するExcelVBAコード
- VBAでメールを自動送信！エクセルマクロでoutlook操作する方法｜事例&コード付
- VBA to find email in outlook by Message-ID
- メールヘッダの一覧
- 重複したメールを削除するマクロ
- 選択されたメールへの返信メールを表示するマクロ
- OutlookからTaskPrizeへメールを飛ばすマクロ
- Outlook VBA 2003でメールからmessageIDを取得する
- Outlookからの返信メールがスレッドにならない件
- OutlookのメールをExcelに取り込む サブフォルダ対応 追記あり
- How to extract sent items from Outlook shared mailbox in Excel VBA?
- send outlook email in nested view using excel vba
- 添付ファイル付きで署名入れてメールする
