こちらの記事について、カスタマイズ・設定のサポートを開始しました。詳しくはこちらをご覧ください。
以下の記事を参考に、「注文メールの内容をサーバーから受信しExcelに取り込む仕組みのサンプル」という記事を作成しています。よろしかったらどうぞ（＾＾）
http://q.hatena.ne.jp/1207249344
この手の「人間の代わりに自動的に処理する」系のプログラムは、好きだなぁ（＾＾；）
まず、このメールがどのような状態なのかがわからないので（テキストファイル？xlsの中に貼り付けてある？）
質問者さんの作られたプログラムを見てみると。。。
Set FR = Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp)).Find(“*[商品]*”, , xlValues)
ん、使ったことのない命令ばかり（＾＾；）
まず、Findから見ていきます。
「VBA Excel Find」で検索すると。。。こちらのページが分かりやすかったです。
Rangeオブジェクト（範囲を表すオブジェクト）から、条件に当てはまるセルを探す、というメソッドらしいです。
“*[商品]*” となっていますから、おそらく、「 [商品] 」という値を含むセルを探す、ということでしょうか？
３つめのパラメータは「xlValues」となっていますが、検索の対象を指定しているとの事です。この場合、セルの値で探す、という事ですね。
んじゃ、どの範囲を探すのか？が、前のRange( ) で指定されている、、、どこになるんだろ？（＾＾；）
Rangeってのは、どうやって指定してるのか？「VBA Excel range」で検索すると、、こちらのページが見つかりました。
Rangeはプロパティで、Range(最初のセル,最後のセル)ってことらしいです。
最初のセル：Selection
最後のセル：Cells(Rows.Count, Selection.Column).End(xlUp)
ってことらしいです。
・・・Selectionってなんだろうか？（＾＾；） たぶん、今選択しているセルのことだろうけど。。。
「VBA Excel selection」で検索。こちらのページが見つかりました。。。ActiveCellみたいな物らしいですが、
Ｓｅｌｅｃｔｉｏｎの場合は複数のセルを選択しているときは、セルの範囲を返すようです。
うーん、、、よくわからないですが、今選択されているセルから、その列のデータの一番最後の行までを見てるって感じなのかな？
ということで。
こんな感じにシートに貼り付けたメールの文章で、今選択しているセル（上の例では「Ａ1」）から下に、最終行まで見ていくってことにしてみます。
とりあえず、プログラムです。
Sub test()
Dim DB(35) As Variant
Dim imamiterugyou As Integer
Dim imamiterugyou_atai As String
Dim fromgyou As Integer
Dim lastgyou As Integer
Dim shouhinmei_shouhinbangou_color_size As String
Dim shouhinbangounukidashi As String
Dim color As String
Dim size As String
'商品を代入する変数を空にしておきます。
DB(13) = ""
DB(14) = ""
'今選択しているセルの行を求めます。
fromgyou = ActiveCell.Row
'今選択しているセルの最終行を求めます。
lastgyou = ActiveSheet.Cells(ActiveSheet.Rows.Count, ActiveCell.Column).End(xlUp).Row
'今見ている行を設定します。最初は、fromgyouです。
imamiterugyou = fromgyou
Do
'今見てる行の値をimamiterugyou_ataiに入れます。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'今見ている行の値の内容によって、処理を分けます。
If imamiterugyou_atai = "[備考]" Then
'もし、今見てる行が[備考]なら,次の行から
'[ショップ名]が先頭から始まる行の前までをDB(25)に追加していきます。
Do
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
'今見てる行の値を変数に代入します。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'もし今見てる行が「 [ショップ名] 」で始まるなら、備考は終わりなのでループから抜けます。
If InStr(imamiterugyou_atai, "[ショップ名]") = 1 Then Exit Do
'DB(25)に今見てる行の値を追加します。
DB(25) = DB(25) + imamiterugyou_atai
Loop While imamiterugyou <= lastgyou
ElseIf imamiterugyou_atai = "[配送日時指定]" Then
'もし、今見てる行が[配送日時指定]なら、DB(22)に値を入れます。
'まず、２行下の時間とスペースを入れます。
DB(22) = ActiveSheet.Cells(imamiterugyou + 2, ActiveCell.Column) + " "
'次に、１行下の日付を入れます。
DB(22) = DB(22) + ActiveSheet.Cells(imamiterugyou + 1, ActiveCell.Column)
'片方しか値が入っていない場合のために、半角スペースをTrimします
DB(22) = Trim(DB(22))
'今見てる行を３行下にします。
imamiterugyou = imamiterugyou + 3
ElseIf InStr(imamiterugyou_atai, "[送付先]") = 1 Then
'もし今見てる行の先頭が「 [送付先] 」の場合、
'まず、「 [送付先] 」の文字列以降を取り出します。
imamiterugyou_atai = Mid(imamiterugyou_atai, 6)
'DB(30)に漢字の姓名を入れます。半角かっこの「 ( 」の１文字前をTrimしたものとします。
DB(30) = Trim(Mid(imamiterugyou_atai, 1, InStr(imamiterugyou_atai, "(") - 1))
'DB(31)に姓名のフリガナを入れます。半角かっこで囲まれた部分とします。
DB(31) = Mid(imamiterugyou_atai, InStr(imamiterugyou_atai, "(") + 1, InStr(imamiterugyou_atai, ")") - InStr(imamiterugyou_atai, "(") - 1)
'次の行に郵便番号、住所が入っているとします。
imamiterugyou = imamiterugyou + 1
'今見てる行の値を変数に代入します。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'郵便番号は、この行の２文字目から、最初の半角スペースの前までとします。
DB(32) = Mid(imamiterugyou_atai, 2, InStr(imamiterugyou_atai, " ") - 2)
'住所は、最初の半角スペースの後ろとします。
DB(33) = Mid(imamiterugyou_atai, InStr(imamiterugyou_atai, " ") + 1)
'次の行に電話番号が入ってるとします。
imamiterugyou = imamiterugyou + 1
'今見てる行の値を変数に代入します。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'電話番号は、この行の７文字目以降とします。
DB(34) = Mid(imamiterugyou_atai, 7)
ElseIf imamiterugyou_atai = "[商品]" Then
'以下、商品の抜出です。
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
Do
'色とサイズの変数を空にします。
color = ""
size = ""
'１行目の商品名（商品番号＋カラー＋サイズ）の行をshouhinmei_shouhinbangou_color_sizeに代入します。
shouhinmei_shouhinbangou_color_size = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
Do
'今見てる行の値を変数に代入します。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'もし、今見ている行が、「 価格 」から始まる行ならば、ループから抜けます
If InStr(imamiterugyou_atai, "価格") = 1 Then Exit Do
'もし、今見てる行が、「カラー:」から始まる行ならば、colorにカラーを入れます。
If InStr(imamiterugyou_atai, "カラー:") = 1 Then
color = Mid(imamiterugyou_atai, 5)
End If
'もし、今見てる行が、「サイズ:」から始まる行ならば、sizeにサイズを入れます。
If InStr(imamiterugyou_atai, "サイズ:") = 1 Then
size = Mid(imamiterugyou_atai, 5)
End If
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
Loop While imamiterugyou <= lastgyou
'商品番号を抜き出します。商品番号は、shouhinmei_shouhinbangou_color_sizeのかっこの内側
'の文字列の後ろについているカラーとサイズを省いた部分です。
'取りあえず、「(」より後ろの文字を抜き出します。
shouhinbangounukidashi = Mid(shouhinmei_shouhinbangou_color_size, InStr(shouhinmei_shouhinbangou_color_size, "(") + 1)
'最後の「)」を除きます。
shouhinbangounukidashi = Mid(shouhinbangounukidashi, 1, Len(shouhinbangounukidashi) - 1)
'カラーとサイズの文字数文だけ、後ろを削除します。
shouhinbangounukidashi = Mid(shouhinbangounukidashi, 1, Len(shouhinbangounukidashi) - Len(color + size))
'DB(13)に連結します。
DB(13) = DB(13) + IIf(DB(13) <> "", ",", "") + shouhinbangounukidashi
'今見ている価格の行から、個数を抜き出します。
'まず、「x 」から後ろの文字列を抜き出します。
imamiterugyou_atai = Mid(imamiterugyou_atai, InStr(imamiterugyou_atai, "x ") + 2)
'次に、「(」より前の文字列を抜き出します。これが個数です。
imamiterugyou_atai = Mid(imamiterugyou_atai, 1, InStr(imamiterugyou_atai, "(") - 1)
'DB(14)に連結します。
DB(14) = DB(14) + IIf(DB(14) <> "", ",", "") + shouhinmei_shouhinbangou_color_size + "x " + imamiterugyou_atai
Do
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
'今見てる行の値を変数に代入します。
imamiterugyou_atai = ActiveSheet.Cells(imamiterugyou, ActiveCell.Column)
'もし、その行が*********************************************************************だったら、ループから抜けます。
If imamiterugyou_atai = "*********************************************************************" Then Exit Do
'もし、その行が----------だったら、ループから抜けます。
If imamiterugyou_atai = "----------" Then Exit Do
Loop While imamiterugyou <= lastgyou
'もし、今見た行が*********************************************************************だったら、ループから抜けます。
If imamiterugyou_atai = "*********************************************************************" Then Exit Do
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
Loop While imamiterugyou <= lastgyou
Else
'今見てる行を１行下にします。
imamiterugyou = imamiterugyou + 1
End If
Loop While imamiterugyou <= lastgyou
If DB(13) = "" Then MsgBox "商品が見つかりません", 48: Exit Sub
If DB(30) = "" Then MsgBox "送付先が見つかりません", 48: Exit Sub
Debug.Print "DB(13)="; DB(13)
Debug.Print "DB(14)="; DB(14)
Debug.Print "DB(22)="; DB(22)
Debug.Print "DB(25)="; DB(25)
Debug.Print "DB(30)="; DB(30)
Debug.Print "DB(31)="; DB(31)
Debug.Print "DB(32)="; DB(32)
Debug.Print "DB(33)="; DB(33)
Debug.Print "DB(34)="; DB(34)
End Sub
（＾＾；）ひたすら長っ・・・
とりあえず、実行結果は、以下のとおり。
ん。いいんでないかい？（＾＾）
ただし、、、これで完成とはいえません。
どのようなメールの文面でも正確に抜き出せるか、というと、今サンプルで出ているメールの文面であれば問題ないですが、
例えば、
・漢字の姓名欄に半角のかっこが入っていた場合（それ以降をフリガナとみなします）
・郵便番号がない場合
・住所や、名前、電話番号が複数行で入っている場合
・備考の内容が 「[ショップ名]」から始まる文字列が入っていた場合（本来の備考として取り込めない行が発生します）
・今出ている行以外に余計な行があった場合（出来るだけ無視するようにしてありますが、、）
など、こちらで想定していない形のデータがきた場合は、うまく抜き出せません。
とりあえず、こちらに置いときます。→vbastudy_22
http://q.hatena.ne.jp/1207249344 の質問者です。
記載いただいた内容で希望通りの動作を確認しました。
今まで手作業でコピペしており、ミスが多発していたので大変助かりました。
ありがとうございます。
＞ 想定していない形のデータがきた場合は、うまく抜き出せません。
過去のデータを100件ほど取り込みイレギュラーで対応できないケースが2種類だけありました。
大変申し訳ありませんが、この2種類のイレギュラーの対応方法について教えていただけませんでしょうか？
お力添えいただければ幸いです。
１）ポイント利用の行が存在すると、商品名にポイントの値が入ってしまう。
メールの金額の部分が▼次の場合DB(14)は”手ぬぐい(J010201パープル)x 2,Tシャツ(A020202レッドM)x 1″ではなく”-100″となります。
２）カラー:とサイズ:が通常は2行で表示されるが、1行になることがある。
▼通常（PCからの注文）
カラー:レッド
サイズ:M
▼イレギュラー（携帯から注文）
カラー:レッド サイズ:M
携帯から注文を受けると本来2行のものがなぜか1行になります。
この場合、カラーとサイズは半角スペースで分けられています。
ictaさん、コメントありがとうございます。
＞記載いただいた内容で希望通りの動作を確認しました。
それはなによりです（＾＾）
イレギュラーの件。
まず、１）のほうですが、当方では、
http://q.hatena.ne.jp/1207249344
で示されているサンプルに、ポイント利用の行を追加して取り込みをしても、
商品名は正常に取り込み出来てました。
ですので、おそらく他に何が原因があると思います。
可能であれば、取り込み出来ないメールの全文をお教えいただけますでしょうか？
名前や住所などは適当にダミーにして頂いてもかまいません。
コメント欄で公開される事が不都合であれば、toi＠simple-sys.com（＠は半角にしてください）宛までメール頂いても結構です。
２）については、例えば、[商品]の欄を取り込んでいる際に、
「カラー:」から始まる行で、かつ、「サイズ:」を含んでいる行があった場合、携帯からの注文とみなして取り込む、といった処理を組み込むことは可能だと思います。
ただ、携帯からの注文で、カラーがない、またはサイズがないデータの場合、どのようになるのでしょうか？その時、どのような文章がくるかによっても、取り込み方は変わりますね。
お返事ありがとうございます。
お力添えに感謝しております。
１）については解決しました。別のコードが影響していました。確認不足で申し訳ありません。
２）については以下のようになっています。
▼カラー、サイズがあるデータ
[商品]
Tシャツ（龍）(A020202パープル×ネイビー2)
カラー:パープル×ネイビー サイズ:2
価格 6400(円) x 1(個) = 6400(円) (税込、送料別)
▼カラーのみのデータ
[商品]
Tシャツ（龍）(A020202パープル×ネイビー)
カラー:パープル×ネイビー
価格 6400(円) x 1(個) = 6400(円) (税込、送料別)
▼サイズのみのデータ
[商品]
Tシャツ（龍）(A0202022)
サイズ:2
価格 6400(円) x 1(個) = 6400(円) (税込、送料別)
▼カラーもサイズもないデータ
[商品]
Tシャツ（龍）(A020202)
価格 6400(円) x 1(個) = 6400(円) (税込、送料別)
もし何か他にも説明不足の点がありましたらお知らせください。
よろしくお願いいたします。
ictaさん、コメントありがとうございます。
2）について、了解しました。
http://www.simple-sys.com/blog/wp-content/uploads/2008/04/vbastudy_22-1.xls
にあらためて携帯での注文に対応して取り込むマクロを組み込みました。
ダウンロードしてご確認ください。
ちょっと質問させてください。
http://q.hatena.ne.jp/1207249344
のコメント欄や、そのコメント欄にあった過去のご質問
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200608/06080229.txt
から推測するに、このメールは、「楽○」さんのショップの方が受け取られる
注文メールだと思うのですが、
・「楽○」さんからの受注情報は、このようなメールでしか情報が来ないのでしょうか？
データダウンロードなどの機能は、「楽○」さんでは用意がないのでしょうか？
・「楽○」さん以外からの注文はこの処理では考えていらっしゃらないのでしょうか？
・BSMTP.DLL等を使用して自動的にメールの取り込み→Excelシートの作成
ができるような仕組みが出来ればさらに便利になるとは思いますが、
そのあたりはご興味ありますか？
ご興味があれば、簡単なサンプルを作ってみます（＾＾）
以上、よろしかったらお教えください。
> ダウンロードしてご確認ください。
期待通りに動作しました。
お手数を煩わせて申し訳ありませんでした。
これでメールの内容を手作業に頼らず完全に取り込むことが可能になりました。
本当にありがとうございます。
>「楽○」さんからの受注情報は、このようなメールでしか情報が来ないのでしょうか？
> データダウンロードなどの機能は、「楽○」さんでは用意がないのでしょうか？
基本的に楽天は楽天のシステム内で自己完結するシステムになっています。
もしCSVなどでデータをダウンロードすれば月額1000円とデータ100件を超える部分につき1件あたり10円（消費税別）の追加利用料がかかるようにようになっています。
私の場合、自社ドメインサイトを先に運用していたので楽天のシステムは使いづらく、データをダウンロードするだけで使用料を支払うのは馬鹿らしいのでマクロで運用してきました。
> 「楽○」さん以外からの注文はこの処理では考えていらっしゃらないのでしょうか？
自社ドメインでは同じようなマクロを組んで運用しています。
こちらはメールの内容を変更できるので、楽天ほど苦労しませんでした。
> BSMTP.DLL等を使用して自動的にメールの取り込み→Excelシートの作成ができるような仕組みが出来ればさらに便利になるとは思いますが、そのあたりはご興味ありますか？
興味はあるのですが、メールが楽天だけではなく自社ドメインもあり、取り込みが複雑すぎるのと、実際に運用するのがエクセルの知識のほとんどないアルバイトなので躊躇しております。
メールの内容も多少変更があったりして柔軟に対応しにくくなるのを恐れています。
本当はファイルメーカーなどでリレーショナルデータベースを組みたいのですが、末端のスタッフが新しいものについてこられないので数万行になった今日でもエクセルで運用している次第です。
もしよろしければ今回ご回答いただいた内容をhatenaに投稿していただけませんでしょうか？
きっと同じような悩みを持っている楽○出店者もいると思います。何かの手助けになると思われますのでよろしくお願いいたします。
ictaさま、コメントありがとうございます。
また、質問にもお答えいただき、ありがとうございました。
＞これでメールの内容を手作業に頼らず完全に取り込むことが可能になりました。
無事動いて何よりです（＾＾）
＞もしCSVなどでデータをダウンロードすれば月額1000円とデータ100件を超える
＞部分につき1件あたり10円（消費税別）の追加利用料がかかるようにようになっています。
なるほど。。。それでは件数にもよるとは思いますが、毎月固定+αの料金を支払うのは、馬鹿馬鹿しいですね。
＞興味はあるのですが、メールが楽天だけではなく自社ドメインもあり、取り込みが複雑すぎる
＞のと、実際に運用するのがエクセルの知識のほとんどないアルバイトなので躊躇しております。
＞メールの内容も多少変更があったりして柔軟に対応しにくくなるのを恐れています。
確かに作りこんでしまえばしまうほど、変更があったときにその対応が鈍くなってしまうのはありますね。イレギュラーのことを考えても、ある程度の手作業は逆に残しておくべきなのかもしれません。
＞本当はファイルメーカーなどでリレーショナルデータベースを組みたいのですが、末端の
＞スタッフが新しいものについてこられないので数万行になった今日でもエクセルで運用
＞している次第です。
一日に処理をする件数が手作業でも追いつける件数であれば、このままエクセルでの運用を
お勧めします。ただ、件数が増えてきた場合や、過去のデータも含めての運用などをお考えでしたら、さすがにエクセルではきついですので、データベースが必要ですね。
逆にデータベースなどでシステム化してしまうと、作り方にもよりますが、「ボタン１つで取り込み」など、実際に操作される方の作業は楽で簡単なものにはなるかと思います。
＞もしよろしければ今回ご回答いただいた内容をhatenaに投稿していただけませんでしょうか？
（＾＾；）あくまで、私はエクセルの勉強中なので、あまり自信を持ってhatenaに投稿できるプログラムではないのですよ。エクセルのプロの方からしてみたら、今回のプログラムはとてもエクセルらしからぬ使い方をしているので。。。
データベースを使った仕組みつくりにはある程度精通しているので自信を持った回答が出来るのですが。。。（＾＾；）
今回はこちらも大変勉強になりました。色々教えていただき、ありがとうございました。