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

Question

不規則なフォーマットのメール内容をエクセルに抽出したいのですが、どなたかお教えいただけませんでしょうか。

小さな会社でメール問い合わせの受付をしています。
現在はポータルサイト経由で来たメールの内容をエクセルの表に転記しているのですが、

以前から使っていたポータルからのメールはフォーマットが決まっているため、メール本文から必要なところをコピーし、決まったセルにそのまま貼り付け、MID関数やLENを使って名前や住所など、必要な情報を別の場所に抜き出し、それを自動マクロを駆使して別のワークシートにある表にコピーする方法で何とか自動化することができていました。

ところが、最近加入したポータル経由の問い合わせメールは、項目の上から順に入力のあったところだけが表示されていて行数がバラバラなので、上記の方法が使えません。

例１）

問い合わせ番号:0000001
お名前:○山○子
メールアドレス:aaa@aaa.com
詳しい内容:掲載の商品について教えて欲しいのですが
一番気になるのは写真が掲載されているもので、2番目
に気になるのは価格が一番安いものです。
どの商品が一番人気か教えてもらえませんか？
ご希望の連絡方法:メール
年代・性別:30代女性

例２）

問い合わせ番号:0000002
お名前:△原△雄
お電話番号:00000000000
FAX番号:0000000000
メールアドレス:bbb@bbb.co.jp
住所:大阪府＊＊＊＊＊＊＊＊＊＊＊
詳しい内容:商品がすぐ欲しいので一度電話で連絡ください
ご希望の連絡方法:電話
ご希望の商品:＊＊＊＊＊＊＊＊
年代・性別:40代男性



といった感じで、「問い合わせ番号」と「お名前」「詳しい内容」以外は
項目があったり無かったりして、行数も場所も定まりません。
さらに「詳しい内容」の欄は文字数が決まっていないため、
何行にもわたる場合があります。


現在は1項目ごとにコピぺでエクセルの表に転記しているのですが、とても大変なのと、ミスをしそうで怖いので、なんとかVBAを使ってエクセルへ取り込みたいのです。

しかしなにぶん自動マクロを駆使する程度のスキルのため、どうすればいいのかさっぱりわかりません。

どなたか良い方法をお教えいただけませんでしょうか。

Wendy02 · Accepted Answer

こんにちは

セルの位置などの具体的な内容がほしかったのですが、位置関係が分からないので、以下のマクロを加工してくださるようにお願いします。パターンは、定型句を使っていることが条件ですから、それが違っているとヒットしません。また、こちらは、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

Wendy02 · Answer

こんにちは。

何も分からないままに読んでいると、まず、例 1)のようなスタイルが問題だとおっしゃっているのですか？例2)も問題だとおっしゃっているのですか？本来、こうあるべきだというフォーマット（書式）で、マクロを動かしているのが、マクロが働かないということなのでしょうか？

実際に、関数やマクロを見せていただいたほうが早いと思います。

実際に、自動化マクロにするためには、どのようにしてよいのか、こちらからでは分からないのです。ボータルから入ってきたデータを、次に、どのようにしていくのか分かりません。コピペと書いてあるのですが、ペースト側の貼り付けのシートやセルの位置などはどうなっているのでしょうか？

>「問い合わせ番号」と「お名前」「詳しい内容」以外は
>項目があったり無かったりして、行数も場所も定まりません。

どのようにしたらよいのか、肝心な点が分からないので、今のところは手が付けられません。ある程度VBAが分かる方なら、こういう場合は、配列変数にして、項目の受け皿を用意して、後は正規表現で、検索して代入すればよいだろうというアドバイスだけで済みますが、たぶん、それでは理解されないと思います。

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

こんにちは

こんにちは。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング