明日までに〇〇部の社員リスト作っといてね
こんな経験はありませんか？
仕事をしていると社員のリストが必要になるシーンありますよね。
しかし、その作業、実は自動でできるんです！
この記事ではExcel VBAを使って社員をExcelに出力する方法をご紹介します。
事前準備 ー Outlook VBAを使う設定 ー
社員情報をどこから取り出すかというと、Outlookに登録されている情報から取り出します。
なので、今回はExcel VBAを使って間接的にOutlook VBAを操作することになります。
まずは、Excel VBAでOutlook VBAを操作するための設定をしていきます。
わたしの場合、16.0を選択しています。
以下のようにチェックが入っていたらOKです！
これで下準備は完了です！
コードの紹介（コピペOK）
以下がコードの全文です。
コピペすればそのまま使えます！
Option Base 1
Sub Outlookメンバー出力()
'メンバーを格納する配列を作成
Dim member_list(10000, 20) As String
'Outlook VBAを利用するためのおまじない
Dim OTL As Outlook.Application
'Outlookのアプリケーションオブジェクトを作成する
Set OTL = CreateObject("Outlook.Application")
Dim myNameSpace As Namespace
Dim myAddressList As AddressList
Dim myAddressEntries As AddressEntries
Set myNameSpace = OTL.Application.GetNamespace("MAPI")
Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")
Set myAddressEntries = myAddressList.AddressEntries
Dim l As AddressEntry
Dim oExUser As ExchangeUser
'ループ処理で社員情報を配列に格納する
cnt = 1
For Each l In myAddressEntries
Set oExUser = l.GetExchangeUser
If Not oExUser Is Nothing Then
member_list(cnt, 1) = cnt 'NO
member_list(cnt, 2) = oExUser.CompanyName '社名
member_list(cnt, 3) = oExUser.JobTitle '役職
member_list(cnt, 4) = oExUser.Name '氏名
member_list(cnt, 5) = oExUser.PrimarySmtpAddress 'メールアドレス
'member_list(cnt, 6) = oExUser.●●●● '項目追加
'member_list(cnt, 7) = oExUser.●●●● '項目追加
'member_list(cnt, 8) = oExUser.●●●● '項目追加
'member_list(cnt, 9) = oExUser.●●●● '項目追加
cnt = cnt + 1
End If
Next
ActiveCell.Cells(1, 1).Resize(10000, 20) = member_list
'列の幅を自動調整する
ActiveCell.Range("A1").Resize(1, UBound(member_list, 2)).EntireColumn.AutoFit
'フォントをMeiryo UI にする
ActiveCell.Range("A1").CurrentRegion.Font.Name = "Meiryo UI"
'罫線を挿入する
ActiveCell.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
Set OTL = Nothing
MsgBox "処理が完了しました！"
End Sub実際にコードを実行する前に、リストを出力したいシートのA1セルを選択してください。
選択後、コードを実行するとそのシートにリストが作成されます。
コードの説明
社員情報を格納する配列を作成
社員情報はひとりずつ取り出すことになりますが、毎回Excelに転記していては時間がかかってしまいます。
なので、member_listという情報を格納する箱のようなものを用意して最後にExcelのシートに張り付けます。
'メンバーを格納する配列を作成
Dim member_list(10000, 20) As Stringここでは、社員が多くても大丈夫なように10,000人分の箱を用意しています。
Outlook VBAの設定
次にOutlook VBAを利用するための設定をしていきます。
ここでは、コードの説明を省きます。「おまじない」だと思ってそのままコピーしましょう。
'Outlook VBAを利用するためのおまじない
Dim OTL As Outlook.Application
'Outlookのアプリケーションオブジェクトを作成する
Set OTL = CreateObject("Outlook.Application")
Dim myNameSpace As Namespace
Dim myAddressList As AddressList
Dim myAddressEntries As AddressEntries
Set myNameSpace = OTL.Application.GetNamespace("MAPI")
Set myAddressList = myNameSpace.AddressLists("Offline Global Address List")
Set myAddressEntries = myAddressList.AddressEntries
Dim l As AddressEntry
Dim oExUser As ExchangeUserOutlookの中の社員情報を引き抜く（メイン部分）
ここからがメイン部分になります。
For文で社員情報をひとりひとり抜き出して、member_listの配列に入れていきます。
'ループ処理で社員情報を配列に格納する
cnt = 1
For Each l In myAddressEntries
Set oExUser = l.GetExchangeUser
If Not oExUser Is Nothing Then
member_list(cnt, 1) = cnt 'NO
member_list(cnt, 2) = oExUser.CompanyName '社名
member_list(cnt, 3) = oExUser.JobTitle '役職
member_list(cnt, 4) = oExUser.Name '氏名
member_list(cnt, 5) = oExUser.PrimarySmtpAddress 'メールアドレス
'member_list(cnt, 6) = oExUser.●●●● '項目追加
'member_list(cnt, 7) = oExUser.●●●● '項目追加
'member_list(cnt, 8) = oExUser.●●●● '項目追加
'member_list(cnt, 9) = oExUser.●●●● '項目追加
cnt = cnt + 1
End If
NextoExUser.●●●●の黒丸の部分を変えることで社員に関するいろんな情報を取り出すことができます。
今回のコードでは、「会社名（.CompanyName）」「役職（.JobTitle）」「氏名（.Name）」「メールアドレス（.PrimarySmtpAddress）」を取り出しています。
他の情報も欲しかったら、その下にmember_list(cnt,数字)と続けて、取り出してください。
以下のような情報がとれます。
| 項目 | コード |
|---|---|
| メールアドレス | .PrimarySmtpAddress |
| 苗字 | .LastName |
| 苗字よみがな | .YomiLastName |
| 名前 | .FirstName |
| 名前よみがな | .YomiFirstName |
| フルネーム（苗字＋名前） | .Name |
| 役職名 | .JobTitle |
| 会社名 | .CompanyName |
| 会社名よみがな | .YomiCompanyName |
| 部署名 | Department |
| 部署名よみがな | .YomiDepartment |
| 市町村 | .City |
| 番地 | .StreetAddress |
| 郵便番号 | .PostalCode |
| 会社所在地 | .OfficeLocation |
| 携帯電話番号 | .MobileTelephoneNumber |
| 会社電話番号 | .BusinessTelephoneNumber |
| X400形式のメールアドレス | .Adress |
| エイリアス | .Alias |
社員情報をExcelに出力
最後に配列に入れた社員情報をExcelに出力します。
ActiveCell.Cells(1, 1).Resize(10000, 20) = member_list
'列の幅を自動調整する
ActiveCell.Range("A1").Resize(1, UBound(member_list, 2)).EntireColumn.AutoFit
'フォントをMeiryo UI にする
ActiveCell.Range("A1").CurrentRegion.Font.Name = "Meiryo UI"
'罫線を挿入する
ActiveCell.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous最初の１文でExcelに社員情報を貼り付けています。
選択されたセル（Activecell）が表の一番左上になるように出力するので
出力したいセルを選択してからコードを実行しましょう。
2行目以降で、セルの列幅を調整したり、フォントを変えたりと形を整えています。
これで社員をリスト化することができました！
参考にしたサイト
今回は「てじらぼ」さんのこちらのページを参考に作成いたしました。
こちらのページにはOutlook VBAの詳しい説明も書いてあるので、ぜひ参考にしてください！
