投稿日: 投稿者: mabo52

エクセルＶＢＡーーーＳＰＬＩＴ編（Split）メールから項目の抜き出し（2）

具体的な手順として，メール文面の空白・改行を除いて，buffer 等の変数に入れるのは同じです。

buffer="————————————————————▼送信内容————————————————————お名前=佐藤太郎ご所属=自宅ご所属先電話=00000000000メールアドレス=xxxyyy@dummy.com申し込み種別=会員所属支部=ロサンゼルス県登録番号=00999会員番号=10000999————————————————————送信日時:2024/09/28(Sat) 19:22:00"

次に，必要のない頭とお尻の部分を次のようにして除きます。

buffer1="------------------------------------------------------------送信日時"
buffer = Mid(Honbun, InStr(Honbun, "お名前=")) '「お名前=」以前の項目を消す
buffer = Left(buffer, InStr(buffer, buffer1) - 1) 'buffer1の部分を消去

　’　buffer1に当てはまる部分を消去

これで，buffer　の中身は，

buffer="お名前=佐藤太郎ご所属=自宅ご所属先電話=00000000000メールアドレス=xxxyyy@dummy.com申し込み種別=会員所属支部=ロサンゼルス県登録番号=00999会員番号=10000999"

になります。これをさらに，「=」を区切りで，split　で分割して，配列にいれます。

preArray = Split(buffer, "=")

こうすると，preArray　の配列に次のように格納されます。項目の値は架空のものです。

preArray(0)="お名前"
preArray(1)="佐藤太郎ご所属"
preArray(2)="自宅ご所属先電話"
preArray(3)="00000000000メールアドレス"
preArray(4)="xxxyyy@dummy.com申し込み種別"
preArray(5)="会員所属支部"
preArray(6)="ロサンゼルス県登録番号"
preArray(7)="00999会員番号"
preArray(8)="10000999"

この格納の様子を見ると，目的の項目の値，例えば「お名前」はpreArray(0)に入ってますが，その値は「お
名前」の入ってる次の配列（preArray(1)）に格納されています。つまり項目の値を見るには，配列の
引数＋１にすればいいことになります。そこで，あらかじめ予想される項目を入れた配列をもとに，preArray　
の配列のどこに項目があるか検索します。項目の順番を催しによって変更する可能性があるからです。

koumokuArray = Array("お名前", "ご所属", "電話", "メールアドレス", "申し込み種別", "所属支部", "登録番号", "会員番号", "住所", "郵便番号", "参加資格")
For j = LBound(koumokuArray) To UBound(koumokuArray)
　If InStr(preArray(i), koumokuArray(j)) > 0 Then
　　nukidasi = preArray(i + 1) '目的の項目の値は　+1の配列に格納されている
　　koumoku = koumokuArray(j)
　　Exit For '見つかった時ループを抜ける
　End If
Next j

検索して該当する引数が見つかったら，引数＋１して，項目の値を取得して，一時変数　nukidasi　に格納し
ます。同時に検索した項目も，koumoku　に格納します。ただ，まだ，nukidasi　には，

佐藤太郎ご所属

のように，次番の項目も一緒に格納されいているので，

 For k = LBound(koumokuArray) To UBound(koumokuArray) '余分な項目を除く
　　nukidasi = Replace(nukidasi, koumokuArray(k), "")
　Next k

のようにして，該当する項目を削除します。その後，koumoku　に応じた外部変数に　Select Case　にて
記憶します。それぞれのケースでは，「県」「支部」「都」を除く処理や，文字長を制限する処理もしてあり
ます。

Select Case koumoku
　　Case "お名前"
　　　　simei = nukidasi
　　Case "ご所属"
　　　　syozoku = nukidasi
　　　　　If Len(syozoku) > 20 Then
　　　　　　　syozoku = Mid(syozoku, 1, 20)
　　　　　End If
　　Case "電話"
　　　　denwa = nukidasi
　　Case "メールアドレス"
　　　　　adoresu = nukidasi
　　Case "申し込み種別"
　　　　　syubetu = nukidasi
　　Case "所属支部"
　　　　　sibu = nukidasi
　　　　　sibu = Replace(sibu, "支部", "")
　　　　　sibu = Replace(sibu, "県", "")
　　　　　If sibu <> "京都" Then
　　　　　　sibu = Replace(sibu, "都", "")
　　　　　End If
　　Case "登録番号"
　　　　bangou = nukidasi
　　Case "会員番号"
　　　　kaiin_bangou = nukidasi
　　Case "郵便番号"
　　　　yubin = nukidas
　　Case "住所"
　　　　jyuusyo = nukidasi
　　Case "参加資格"
　　　　sanka_sikaku = nukidasi
End Select

以上が処理の流れですが，これをサブとして呼び出せるようにしてあります。以下が全文です。


Private Sub mail_koumoku_nukidasi(Honbun As String)
    Dim preArray As Variant
    Dim koumokuArray() As Variant
    Dim buffer, buffer1, nukidasi,koumoku As String
    Dim i, j, k As Integer
    
    '最終項目の後の文字
    buffer1 = "------------------------------------------------------------送信日時"
    '予想される項目
    koumokuArray = Array("お名前", "ご所属", "電話", "メールアドレス", "申し込み種別", "所属支部", "登録番号", "会員番号", "住所", "郵便番号", "参加資格")
  
    '本文前処理
    buffer = Mid(Honbun, InStr(Honbun, "お名前="))              '「お名前=」以前の項目を消す
    buffer = Left(buffer, InStr(buffer, buffer1) - 1)           '最終項目以下を消す
    buffer = Replace(buffer, "ご所属先電話", "電話")            '「ご所属」と「ご所属先電話」検索で区別が付かないので，置き換え
    
    preArray = Split(buffer, "=")                              '"="を区切りで分割
     
    For i = LBound(preArray) To UBound(preArray) - 1
       For j = LBound(koumokuArray) To UBound(koumokuArray)
        If InStr(preArray(i), koumokuArray(j)) > 0 Then
                    nukidasi = preArray(i + 1)                    '目的の項目は　+1の配列に格納されている
                    koumoku = koumokuArray(j)　　　　　　　　　　'項目の保持
                    Exit For                                      '見つかった時ループを抜ける
           Exit For
        End If
       Next j
       
       For k = LBound(koumokuArray) To UBound(koumokuArray)        '余分な項目を除く
            nukidasi = Replace(nukidasi, koumokuArray(k), "")
       Next k
        '項目に応じた変数に格納する
        Select Case koumoku
            Case "お名前"
                simei = nukidasi
            Case "ご所属"
                syozoku = nukidasi
                If Len(syozoku) > 20 Then
                    syozoku = Mid(syozoku, 1, 20)
                End If
            Case "電話"
                denwa = nukidasi
            Case "メールアドレス"
                adoresu = nukidasi
            Case "申し込み種別"
                syubetu = nukidasi
            Case "所属支部"
                sibu = nukidasi
                sibu = Replace(sibu, "支部", "")
                sibu = Replace(sibu, "県", "")
                If sibu <> "京都" Then
                    sibu = Replace(sibu, "都", "")
                End If
            Case "登録番号"
                bangou = nukidasi
            Case "会員番号"
                kaiin_bangou = nukidasi
            Case "郵便番号"
                yubin = nukidas
            Case "住所"
                jyuusyo = nukidasi
            Case "参加資格"
                sanka_sikaku = nukidasi
        End Select
        
    Next i
    
End Sub

自分なりに作成しましたが，きっと，もっとうまい方法があるんでしょうね。

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

CAPTCHA