2020年2月 – リボン日記

Outlook のメールを読んで、指定した情報をVBAを使って抜き出す

データベースを使わない、または外部のウェブサービスからのメールを受信していて、そのメールの中から住所を抜き出し、顧客分布を測定したい時がある。Excel とOutlook ならVBA が使えるので、それを一部自動化した。

この解説は、限られた条件で使ったものなので、サンプルプログラムとして記録を残す。

前提

Oltlook の受信トレイに「予約」フォルダ、その直下に「A店」と「B店」のフォルダがある

受信トレイ
└予約
├A店
└B店

それぞれのフォルダはOutlook のルールで、件名ごとにフォルダ分けされるようになっている

「A店」と「B店」に保存されたメールの中に、「住所」情報がある

実装したい機能

指定したフォルダを次々に読み込んで、住所を抜き出し、都道府県、市町村、区、その他で横方向のセルに挿入する

セルは横方向が属性、縦方向がメールごとの内容にして、データを表に入力する

VBA スクリプト

'Outlook の指定フォルダから､一気にメール内容の住所を取得して､都道府県､市､区､で分ける
'「住所」の次の行を調べているだけなので、メールがメールフォームを使わずに返信してきた場合は住所が決まった位置に書かれていないため抜ける

'全てのプロシージャで使用できる変数宣言
Dim subFolder As String ' サブフォルダ名
Dim folderArray() As String ' 選択するフォルダ名
Dim nextRow As Long '挿入するセルの開始行

Sub GetCustomersAddress()

    '初期設定
    'フォルダ構造は次のようになっている
    '受信トレイOutlook 2013
    '└予約
    '　├A店
    '　├B店
    '　└C店
    ReDim folderArray(2)
    subFolder = "予約"
    folderArray(1) = "A店"
    folderArray(2) = "B店"

    nextRow = 2

    '指定したフォルダ内にGetMail()の処理を実施する
    Call GetMail(subFolder, folderArray(1), nextRow)
    Call GetMail(subFolder, folderArray(2), nextRow)

End Sub

'Outlook にある指定されたフォルダを順に読み込み、「住所」が書かれた行の次の行にある住所を、都道府県、市区町村、以下で分けてセルに記載する
Function GetMail(ByVal nowFolder As String, ByVal ssFolder As String, ByVal nowRow As Long)
    Dim objOutlook As Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myInbox, mySubfolder

    Set objOutlook = New Outlook.Application ' Outlook アプリケーションオブジェクトの取得
    Set myNamespace = objOutlook.GetNamespace("MAPI") ' Outlook のメールフォルダにアクセスするためのNamespace オブジェクトを取得
    
    ' GetDefaultFolder() の引数olFolderInbox は、受信トレイフォルダー(メール)を指す
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox) ' 受信トレイのフォルダオブジェクトを取得
    Set mySubfolder = myInbox.Folders(nowFolder).Folders(ssFolder) ' 引数で指定された階層のサブフォルダオブジェクトを取得


    Dim i As Long
    Dim ij As Integer
    Dim textSolo As String
    Dim stringLine As String
    Dim sPrefecture As String
    Dim sCity As String
    Dim sKu As String

    ' 取得したサブフォルダmySubfolder のアイテム数をすべて読む
    For i = 1 To mySubfolder.Items.Count
      'シート"email"を指定
      With ThisWorkbook.Worksheets("email")
        arrayLine = Split(mySubfolder.Items(i).Body, vbCrLf) 'メール本文を改行で分割
        '住所を書き出す
        For ij = LBound(arrayLine) To UBound(arrayLine)
            stringLine = arrayLine(ij)
            ' 行が指定のキーワード「住所」なのか確認
            If stringLine Like "*住所*" Then
                textSolo = arrayLine(ij + 1)
                '都道府県
                If (InStr(textSolo, "道") <> 0) Or (InStr(textSolo, "東京都") <> 0) Or (InStr(textSolo, "府") <> 0) Then
                    sPrefecture = Mid(textSolo, 1, 3) ' 都道府県を取得
                    textSolo = Right(textSolo, Len(textSolo) - 3) ' testSolo から都道府県を削除
                ElseIf (InStr(textSolo, "県") <> 0) Then
                    sPrefecture = Mid(textSolo, 1, InStr(textSolo, "県"))
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "県"))
                ElseIf (InStr(textSolo, "名古屋市") <> 0) Then
                    '名古屋市から書き始める人用
                    sPrefecture = "愛知県"
                End If
                .Cells(i + nowRow, 2).Value = sPrefecture ' 都道府県を指定されたセルに記載
                
                '市
                If (InStr(textSolo, "市") <> 0) Then
                    sCity = Mid(textSolo, 1, InStr(textSolo, "市")) ' 市を取得
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "市")) ' textSolo から市までを削除
                ElseIf (InStr(textSolo, "郡") <> 0) Then
                    sCity = Mid(textSolo, 1, InStr(textSolo, "郡"))
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "郡"))
                Else
                    sCity = ""
                End If
                .Cells(i + nowRow, 3).Value = sCity ' 市を指定されたセルに記載
                '区
                If (InStr(textSolo, "区") <> 0) Then
                    sKu = Mid(textSolo, 1, InStr(textSolo, "区")) ' 句を取得
                    textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "区")) ' textSolo から区までを削除
                Else
                    sKu = ""
                End If
                .Cells(i + nowRow, 4).Value = sKu ' 区を指定されたセルに記載
                .Cells(i + nowRow, 5).Value = textSolo ' それ以外の住所を指定されたセルに記載
            End If
        Next
      End With
    Next i

    nextRow = nowRow + mySubfolder.Items.Count
End Function

100

101

102

103

'Outlook の指定フォルダから､一気にメール内容の住所を取得して､都道府県､市､区､で分ける

'「住所」の次の行を調べているだけなので、メールがメールフォームを使わずに返信してきた場合は住所が決まった位置に書かれていないため抜ける

'全てのプロシージャで使用できる変数宣言

Dim subFolder As String ' サブフォルダ名

Dim folderArray() As String ' 選択するフォルダ名

Dim nextRow As Long '挿入するセルの開始行

Sub GetCustomersAddress()

'初期設定

'フォルダ構造は次のようになっている

'受信トレイOutlook 2013

'└予約

'　├A店

'　├B店

'　└C店

ReDim folderArray(2)

subFolder = "予約"

folderArray(1) = "A店"

folderArray(2) = "B店"

nextRow = 2

'指定したフォルダ内にGetMail()の処理を実施する

Call GetMail(subFolder, folderArray(1), nextRow)

Call GetMail(subFolder, folderArray(2), nextRow)

End Sub

'Outlook にある指定されたフォルダを順に読み込み、「住所」が書かれた行の次の行にある住所を、都道府県、市区町村、以下で分けてセルに記載する

Function GetMail(ByVal nowFolder As String, ByVal ssFolder As String, ByVal nowRow As Long)

Dim objOutlook As Outlook.Application

Dim myNamespace As Outlook.Namespace

Dim myInbox, mySubfolder

Set objOutlook = New Outlook.Application ' Outlook アプリケーションオブジェクトの取得

Set myNamespace = objOutlook.GetNamespace("MAPI") ' Outlook のメールフォルダにアクセスするためのNamespace オブジェクトを取得

' GetDefaultFolder() の引数olFolderInbox は、受信トレイフォルダー(メール)を指す

Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox) ' 受信トレイのフォルダオブジェクトを取得

Set mySubfolder = myInbox.Folders(nowFolder).Folders(ssFolder) ' 引数で指定された階層のサブフォルダオブジェクトを取得

Dim i As Long

Dim ij As Integer

Dim textSolo As String

Dim stringLine As String

Dim sPrefecture As String

Dim sCity As String

Dim sKu As String

' 取得したサブフォルダmySubfolder のアイテム数をすべて読む

For i = 1 To mySubfolder.Items.Count

'シート"email"を指定

With ThisWorkbook.Worksheets("email")

arrayLine = Split(mySubfolder.Items(i).Body, vbCrLf) 'メール本文を改行で分割

'住所を書き出す

For ij = LBound(arrayLine) To UBound(arrayLine)

stringLine = arrayLine(ij)

' 行が指定のキーワード「住所」なのか確認

If stringLine Like "*住所*" Then

textSolo = arrayLine(ij + 1)

'都道府県

If (InStr(textSolo, "道") <> 0) Or (InStr(textSolo, "東京都") <> 0) Or (InStr(textSolo, "府") <> 0) Then

sPrefecture = Mid(textSolo, 1, 3) ' 都道府県を取得

textSolo = Right(textSolo, Len(textSolo) - 3) ' testSolo から都道府県を削除

ElseIf (InStr(textSolo, "県") <> 0) Then

sPrefecture = Mid(textSolo, 1, InStr(textSolo, "県"))

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "県"))

ElseIf (InStr(textSolo, "名古屋市") <> 0) Then

'名古屋市から書き始める人用

sPrefecture = "愛知県"

End If

.Cells(i + nowRow, 2).Value = sPrefecture ' 都道府県を指定されたセルに記載

'市

If (InStr(textSolo, "市") <> 0) Then

sCity = Mid(textSolo, 1, InStr(textSolo, "市")) ' 市を取得

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "市")) ' textSolo から市までを削除

ElseIf (InStr(textSolo, "郡") <> 0) Then

sCity = Mid(textSolo, 1, InStr(textSolo, "郡"))

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "郡"))

Else

sCity = ""

End If

.Cells(i + nowRow, 3).Value = sCity ' 市を指定されたセルに記載

'区

If (InStr(textSolo, "区") <> 0) Then

sKu = Mid(textSolo, 1, InStr(textSolo, "区")) ' 句を取得

textSolo = Right(textSolo, Len(textSolo) - InStr(textSolo, "区")) ' textSolo から区までを削除

Else

sKu = ""

End If

.Cells(i + nowRow, 4).Value = sKu ' 区を指定されたセルに記載

.Cells(i + nowRow, 5).Value = textSolo ' それ以外の住所を指定されたセルに記載

End If

End With

Next i

nextRow = nowRow + mySubfolder.Items.Count

End Function

動作

スクリプトを実行すると、シート”email”に結果を書き出す

英語学習の現状-2020年2月

以前、「新社会人を英日の翻訳者に育てる」を書いた。その時は、ヒアリングとスピーキングを除外していた。その後わたしが、リーディングと写経では英語の理解力が伸びない問題にぶち当たった。現在、それを改善している。

以前の学習方法

「自分が興味のある分野の英語記事」を1日2本、テキストエディタを使って写経する
わからない単語を辞書引きして手帳に書きとる
それでもわからない時は、Google 翻訳ツールで翻訳して記事を読む
手帳の単語を後で見返す

着眼点

多言語の学習は、「ヒアリングの刺激があると効率が良くなる」と、脳科学の研究者がまとめていた。そこで、ヒアリングを始めた。

ヒアリングの習慣づけ

朝起きたとき、”BBC Learning English” を1本、繰り返して聞く。(スマートフォンアプリを使っている。)
- 6 Minute English
- 6 Minute Grammar
- 6 Minute Vocabulary
興味のある分野の解説動画やハウツーをYouTube で見る
- ジムのバイクを漕いでいる最中によく見ている

備考

Google 翻訳コミュニティを使うようになった。

利用者に利益があるか知りたいので参加している。今のところ、「熟語」が見えるようになってきた。

翻訳できるならそのまま訳し、分からない単語があれば辞書を引く。表現がおかしいものがあれば旗をクリックして「不適切」、「翻訳できない」などを伝える。手掛かりがない場合は「スキップ」して時間を縮める。

Google 翻訳コミュニティとは

Google 翻訳の正誤表を、人力で行うプロジェクト。それぞれの言語間に「翻訳」と「検証」の二種類の作業を、1度に10個ずつこなすボランティア。

Excel の複数のシートで、セルの頭出しをしたい

データの整理で、Excel を使って、別のシートからのデータをコピペする作業がある。毎回決まった位置に目視で確認しながらマウス操作で選択していたが、この頭出しをVBA で実現した。

利用する言語

Visual Basic for Applications (VBA)

実装したい内容

決まったシートから順番に、指定したセルの位置を選択状態にしたい

スクリプト

Option Explicit
' スリープを使う
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'初期設定
Dim ij As Integer

'セル頭出し関数実行
Sub F1st()
    Call FocusCell("C86")
End Sub
Sub F2nd()
    Call FocusCell("C117")
End Sub
Sub F3rd()
    Call FocusCell("C146")
End Sub
' セル頭出し、シートを順番に選択して、指定されたセルを選択状態にする
Function FocusCell(ByVal tCell As String)
    For ij = 4 To Sheets.Count
        Sheets(Sheets(ij).Name).Select
        Sleep 50
        Range(tCell).Activate
        Sleep 50
    Next
    ' 先頭のセルを再び選択
    Sheets(Sheets(4).Name).Select
End Function

Option Explicit

' スリープを使う

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'初期設定

Dim ij As Integer

'セル頭出し関数実行

Sub F1st()

Call FocusCell("C86")

End Sub

Sub F2nd()

Call FocusCell("C117")

End Sub

Sub F3rd()

Call FocusCell("C146")

End Sub

' セル頭出し、シートを順番に選択して、指定されたセルを選択状態にする

Function FocusCell(ByVal tCell As String)

For ij = 4 To Sheets.Count

Sheets(Sheets(ij).Name).Select

Sleep 50

Range(tCell).Activate

Sleep 50

' 先頭のセルを再び選択

Sheets(Sheets(4).Name).Select

End Function

内容

セル頭出し関数F1st() などで、選択するセルの位置を指定
FocusCell() でシート4から順番にシートを選択して、指定されたセルを選択する

AutoHotKey で配列がなぜ関数の中で使えないのを解決する

AutoHotKey を使い始めた人が他の言語を経験していると、「配列が関数の中で参照できない」と詰まることがある。これを解決する。

結論から言えば、グローバル配列を参照するなら、宣言が必要となる。

検証スクリプト

test.ahk

Array := Object()
Array[0] := "item"
Array[1] := 1
Array[2] := 3

MsgArrayTest1() ; 結果：{空白}, {空白}
MsgArrayTest1()
{
	Array[1] := Array[1] + 1
	MsgBox % Array[1]
	MsgBox % Array[0]
}

MsgArrayTest2() ; 結果：2, item
MsgArrayTest2()
{
	global Array ; グローバル変数を参照するための宣言
	Array[1] := Array[1] + 1
	MsgBox % Array[1]
	MsgBox % Array[0]
}

MsgVariable(Array[0]) ; 結果： item
MsgVariable(outString)
{

	MsgBox %outString%
}

MsgArray(Array) ; 結果：3
MsgArray(outString)
{
	MsgBox % outString[2] 
}

Array := Object()

Array[0] := "item"

Array[1] := 1

Array[2] := 3

MsgArrayTest1() ; 結果：{空白}, {空白}

MsgArrayTest1()

{

Array[1] := Array[1] + 1

MsgBox % Array[1]

MsgBox % Array[0]

}

MsgArrayTest2() ; 結果：2, item

MsgArrayTest2()

{

global Array ; グローバル変数を参照するための宣言

Array[1] := Array[1] + 1

MsgBox % Array[1]

MsgBox % Array[0]

}

MsgVariable(Array[0]) ; 結果： item

MsgVariable(outString)

{

MsgBox %outString%

}

MsgArray(Array) ; 結果：3

MsgArray(outString)

{

MsgBox % outString[2]

}