不規則なフォーマットのメール内容をエクセルに抽出したいのですが、どなた

質問

不規則なフォーマットのメール内容をエクセルに抽出したいのですが、どなたかお教えいただけませんでしょうか。

小さな会社でメール問い合わせの受付をしています。
現在はポータルサイト経由で来たメールの内容をエクセルの表に転記しているのですが、

以前から使っていたポータルからのメールはフォーマットが決まっているため、メール本文から必要なところをコピーし、決まったセルにそのまま貼り付け、MID関数やLENを使って名前や住所など、必要な情報を別の場所に抜き出し、それを自動マクロを駆使して別のワークシートにある表にコピーする方法で何とか自動化することができていました。

ところが、最近加入したポータル経由の問い合わせメールは、項目の上から順に入力のあったところだけが表示されていて行数がバラバラなので、上記の方法が使えません。

例１）

問い合わせ番号:0000001
お名前:○山○子
メールアドレス:aaa@aaa.com
詳しい内容:掲載の商品について教えて欲しいのですが
一番気になるのは写真が掲載されているもので、2番目
に気になるのは価格が一番安いものです。
どの商品が一番人気か教えてもらえませんか？
ご希望の連絡方法:メール
年代・性別:30代女性

例２）

問い合わせ番号:0000002
お名前:△原△雄
お電話番号:00000000000
FAX番号:0000000000
メールアドレス:bbb@bbb.co.jp
住所:大阪府＊＊＊＊＊＊＊＊＊＊＊
詳しい内容:商品がすぐ欲しいので一度電話で連絡ください
ご希望の連絡方法:電話
ご希望の商品:＊＊＊＊＊＊＊＊
年代・性別:40代男性

といった感じで、「問い合わせ番号」と「お名前」「詳しい内容」以外は
項目があったり無かったりして、行数も場所も定まりません。
さらに「詳しい内容」の欄は文字数が決まっていないため、
何行にもわたる場合があります。

現在は1項目ごとにコピぺでエクセルの表に転記しているのですが、とても大変なのと、ミスをしそうで怖いので、なんとかVBAを使ってエクセルへ取り込みたいのです。

しかしなにぶん自動マクロを駆使する程度のスキルのため、どうすればいいのかさっぱりわかりません。

どなたか良い方法をお教えいただけませんでしょうか。

回答No.2

Wendy02 · ベストアンサー

こんにちは

セルの位置などの具体的な内容がほしかったのですが、位置関係が分からないので、以下のマクロを加工してくださるようにお願いします。パターンは、定型句を使っていることが条件ですから、それが違っているとヒットしません。また、こちらは、Goo 側から回答していますので、半角和字が使用できませんので、代用のワイルドカードの文字（.）を使っています。例えば、年代・性別の間の、中黒点は全角でも半角でもヒットするように作られています。

Sheet1 のA1 に貼り付けたものを、Sheet2 のA1 に別けて貼りつけます。
なお、「問い合わせ番号」は、０も取れていますが、貼付けの際に「数値」に変わってしまうので、０がなくなってしまいます。書式の文字列にしてください。それができないなら、マクロで処理します。

この文字列を取得するマクロは、慣れている人なら簡単ですが、いくつかのポイントの勉強が必要になります。

'-------------------------------------------

Sub PickUpData()
　　Dim Patterns(8) As String
　　Dim Datas(8) As String
　　Dim Matches As Object
　　Dim c As Range
　　Dim i As Variant
　　Dim buf As String
　　Dim sh As Worksheet
　　Set sh = Worksheets("Sheet1")
　　'パターン群
　　Patterns(0) = "問い合わせ番号:(\d+)"
　　Patterns(1) = "お名前.(.+)$"
　　Patterns(2) = "詳しい内容.(.+)$"
　　Patterns(3) = "お電話番号.([\d\-]+)$"
　　Patterns(4) = "メールアドレス.(.+)$"
　　Patterns(5) = "住所.(.+)$"
　　Patterns(6) = "ご希望の連絡方法.(.+)$"
　　Patterns(7) = "ご希望の商品.(.+)$"
　　Patterns(8) = "年代.性別.(.+)$"
　　With CreateObject("VBScript.RegExp")
　　　 Application.ScreenUpdating = False
　　　　For i = 0 To UBound(Patterns)
　　　　　　.Pattern = Patterns(i)
　　　　　　.Global = False
　　　　　　For Each c In sh.Range("A1", sh.Range("A18"))
　　　　　　　　If c.Value <> "" Then
　　　　　　　　　　Set Matches = .Execute(c.Text)
　　　　　　　　　　If Matches.Count > 0 Then
　　　　　　　　　　　 If i = 2 Then
　　　　　　　　　　　　buf = Matches(0).SubMatches(0)
　　　　　　　　　　　　buf = buf & vbLf & CombineText(c)
　　　　　　　　　　　　Datas(i) = buf
　　　　　　　　　　　 Else
　　　　　　　　　　　　Datas(i) = Matches(0).SubMatches(0)
　　　　　　　　　　　　Exit For
　　　　　　　　　　　 End If
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Next c
　　　　Next i
　　　　Application.ScreenUpdating = True
　　End With

　　'貼付け先
　　Worksheets("Sheet2").Range("A1").Resize(9).Value = Application.Transpose(Datas)
　　Set sh = Nothing
End Sub
Function CombineText(c As Range)
Dim j As Long
Dim buf As String
With ActiveSheet
　For j = 1 To Cells(c.Rows.Count, c.Column).End(xlUp).Row
　　buf = buf & vbLf & c.Offset(1).Text
　Next j
End With
　CombineText = buf
End Function

回答No.1

Wendy02

こんにちは。

何も分からないままに読んでいると、まず、例 1)のようなスタイルが問題だとおっしゃっているのですか？例2)も問題だとおっしゃっているのですか？本来、こうあるべきだというフォーマット（書式）で、マクロを動かしているのが、マクロが働かないということなのでしょうか？

実際に、関数やマクロを見せていただいたほうが早いと思います。

実際に、自動化マクロにするためには、どのようにしてよいのか、こちらからでは分からないのです。ボータルから入ってきたデータを、次に、どのようにしていくのか分かりません。コピペと書いてあるのですが、ペースト側の貼り付けのシートやセルの位置などはどうなっているのでしょうか？

>「問い合わせ番号」と「お名前」「詳しい内容」以外は
>項目があったり無かったりして、行数も場所も定まりません。

どのようにしたらよいのか、肝心な点が分からないので、今のところは手が付けられません。ある程度VBAが分かる方なら、こういう場合は、配列変数にして、項目の受け皿を用意して、後は正規表現で、検索して代入すればよいだろうというアドバイスだけで済みますが、たぶん、それでは理解されないと思います。

お礼

御礼が遅くなり申し訳ありません！

こちらがあいまいな表現でお伝えしていたにもかかわらず、
完璧なコードを書いてくださり、ありがとうございます。

心から感謝しております！！！
本当に助かりました。どうもありがとうございました。
<(_ _*)> ))

補足

ご回答ありがとうございます。
書き方がまずくてすみません。

>例1)のようなスタイルが問題だとおっしゃっているのですか？
>例2)も問題だとおっしゃっているのですか？

これはまず例1)と例2)が混在している事が問題と感じています。

従来から使っているものは、

氏名：＊＊＊＊
メールアドレス：＊＊＊＊
電話番号：＊＊＊＊
・
・
・
問い合わせ内容：＊＊＊＊

という順番が固定しており、空白があっても項目数･･･つまり行数は変わらないので、
メール本文の必要な部分をコピーし、エクセルの決まったセルに貼り付けると、決まった行に決まった項目が入ります。

そこからMID関数などで「氏名：」「メールアドレス：」を省いたものを、別シートに作った一番上の列がタイトル行になっている、よくある一覧表の下にマクロで貼り付けています。
（問い合わせ内容はこちらも文字数不定ですが、一番下なので、そこだけ別にコピーをして特定のセルへ貼り付けています。）

しかしその方法では決まった行に決まった項目が入らないと使えませんので、どうすればいいのか分からず、新しい方のメールはまだマクロを組んでおりません。

現在は従来のものとは別シートで、同じように一番上の列がタイトル行の表を作り、下に名前やメールアドレスなどの項目を一つずつ手作業で貼り付けています。

このような説明でお分かりいただけますでしょうか。

実はＶＢＡも勉強しようと思って独学で取り組んではみたのですが、まず基礎すらあいまいな状態では配列がどうしても理解できないのと、エラー処理、繰り返し処理など、勉強しなければいけないことが山ほどあるようで挫折してしまい、ここに投稿させていただいたのです。時間をかけて学んで行くにしてもハードルが高すぎて、今実務で必要なものを作るには間に合わないのです。

どうかお助けくださいますようお願い致します。