エクセルVBAーーーSPLIT編(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))に格納されています。つまり項目の値を見るには,配列の
引数+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

検索して該当する引数が見つかったら,引数+1して,項目の値を取得して,一時変数 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