ExcelVBAでメールを作成してメーラーを起動するプログラムを作って

ExcelVBAでメールを作成してメーラーを起動するプログラムを作っているのですがうまくいかない点が２つほどあります。

(１)いろいろ条件によって文章を組み立てて、
Excelに一旦、本文を表示するところまで行ったのですが、
それをクリップボードにコピーして、
GetText関数でmailtoのbodyに渡し
メーラーが起動されるのですが、
メール本文を見るとダブルコーテーションで囲われているところがいくつかあり、
(セル内改行があったところなどが
自動的に囲われてしまうみたいで)
改行もされず本文が全部つながってしまいます。

メール本文でダブルコーテーションなしにして元の改行を入れるにはどうしたらいいのでしょうか？

(２)
bodyの本文が長いとエラーになってしまい、
メーラーが起動されません。
２千文字くらいしか入らないみたいです。

入れなければならない文言が決まっているので、
文章の文字数を減らすことはできません。

ダブルコーテーションは消して、
改行をそのまま入れて、
文章の文字数はそのままで、メーラーからを送るにはどうしたらいいか何日か悩んだのですが解決できません。

ご教示お願いします。

No.3 ベストアンサー 回答者： end-u 回答日時： 2010/06/21 18:33

>mailtoコマンド

mailtoプロトコル...ですよねorz

>CreateProcess関数を使うとできそうな記事もありますがちょっとハードルが高そうです。
VBA的には Shell関数を使えばいいのでそうでもないですか。
レジストリを見に行って、既定メーラーを取得して起動オプションに本文をくっつける感じ？

Sub try_3()
　　Const HKEY = "HKEY_CLASSES_ROOT\mailto\shell\open\command\"
　　Dim Flg　 As Boolean
　　Dim Arg　 As String
　　Dim sPath As String
　　Dim i　　 As Long
　　Dim b()　 As Byte
　　Dim tmp, ary

　　On Error GoTo errHandler

　　tmp = Selection.Value
　　If IsArray(tmp) Then
　　　　ReDim ary(1 To UBound(tmp))
　　　　For i = 1 To UBound(tmp)
　　　　　　ary(i) = Join(Application.Index(tmp, i, 0), "")
　　　　Next
　　　　Arg = Join(ary, vbLf)
　　Else
　　　　Arg = tmp
　　End If
　　
　　'既定メーラー取得(WinXP)
　　With CreateObject("WScript.Shell")
　　　　sPath = .ExpandEnvironmentStrings(.RegRead(HKEY))
　　End With
　　sPath = Replace$(Replace$(sPath, """%1""", ""), "%1", "")
　　Flg = InStr(1, sPath, "thunderbird", vbTextCompare)
　　
　　If Flg Then
　　　　'thunderbirdだと文字化けしたのでUTFエンコード
　　　　With CreateObject("ScriptControl")
　　　　　　.Language = "JScript"
　　　　　　Arg = .CodeObject.encodeURI(Arg)
　　　　End With
　　Else
　　　　'簡易的にSJISエンコード
　　　　b = StrConv(Arg, vbFromUnicode)
　　　　Arg = ""
　　　　For i = 0 To UBound(b)
　　　　　　Arg = Arg & "%" & Right$("0" & Hex$(b(i)), 2)
　　　　Next
　　End If
　　
　　Arg = "mailto:メールアドレス?" & _
　　　　　"subject=件名&" & _
　　　　　"body=" & Arg

　　Shell sPath & Arg

　　Exit Sub
errHandler:
　　MsgBox Err.Number & ":" & Err.Description
End Sub

とりあえずwinXPで Outlook/Outlook Express/thunderbird は動きました。
他環境だったりする場合、ここ
http://jehupc.exblog.jp/9727243/
の情報が参考になると思います。

#個人的にはCDOをおすすめしますが

この回答へのお礼

ありがとうございます。
遅くなりましてすみません。
おかげさまで目的のものが作れました。
この方法でやってみたら最終的には、一応うまくいったのですが、
すいません、難しくて内容についてはあまりよく理解できていません。
処理の内容についてもう少し詳しく知りたいので説明して頂けたらありがたいのですが・・・
お願いできないでしょうか？

お礼日時：2010/07/05 02:42

No.5 回答者： end-u 回答日時： 2010/07/06 13:41

OS、メーラーの種類、どんな文字列をどのセルに配置してそういう現象が出るのか

わからないと試しようもないし、答えようもありませんが、
>まったく同じように操作しているのに環境によって違うのでしょうか？
環境によってエラーが発生して動かなかったりする事は多々あります。
ダブルクォートが入ったりするかというのは、解かりません。
データによっては、あるのかもしれません。

必要なら
・OSの種類とバージョン
・Excelのバージョン（2003sp？）
・メーラーの種類とバージョン
・再現可能な最低限の文字列とセル位置情報
・実際に実行したVBAコード
を提示して新規に質問してみてください。
#環境的に私が試せない場合でも、他の方から回答あるかもしれません。

No.4 回答者： end-u 回答日時： 2010/07/05 17:05

要件

１）クリップボード経由だとダブルクォートで囲まれる箇所がある
２）Bodyが改行されない
３）bodyが2,000文字くらいしか渡せない
４）メーラーを特定せず既定メーラーを起動したい

対応１）
Clipboard経由で取得する時、セル内改行があるとダブルクォートで囲まれるのは仕様なので
配列から文字列を繋ぐ方式に変更。

選択セルValueを取得し、
>tmp = Selection.Value
配列の場合は
>If IsArray(tmp) Then
縦方向（行数）分の配列aryを用意し
>　　ReDim ary(1 To UBound(tmp))
複数列選択も考慮しApplication.Index関数を使って行ごとに文字連結する
>　　For i = 1 To UBound(tmp)
>　　　　ary(i) = Join(Application.Index(tmp, i, 0), "")
>　　Next
最後にaryを改行コードで連結
>　　Arg = Join(ary, vbLf)
配列でない（単独セルの）場合はそのまま文字列として取得
>Else
>　　Arg = tmp
>End If

対応２）
mailtoプロトコルの起動オプションとしてBodyを渡す時、改行文字はURLエンコードする必要がある。
同時に、メーラーによっては文字化けするので条件分岐してSJIS/UTFエンコードする。

この辺り（も）、詳しくないので
"VBA URLエンコード"
などでGoogle検索などしてみてください。
http://orenolog.blogspot.com/2008/02/vbsvba-uri. …
>Flg = InStr(1, sPath, "thunderbird", vbTextCompare)
>If Flg Then
>　　'thunderbirdだと文字化けしたのでUTFエンコード
>　　With CreateObject("ScriptControl")
>　　　　.Language = "JScript"
>　　　　Arg = .CodeObject.encodeURI(Arg)
>　　End With
>Else
>　　'簡易的にSJISエンコード
>　　b = StrConv(Arg, vbFromUnicode)
>　　Arg = ""
>　　For i = 0 To UBound(b)
>　　　　Arg = Arg & "%" & Right$("0" & Hex$(b(i)), 2)
>　　Next
>End If

対応３）
Shell関数を使えばmailtoプロトコルの起動オプションに2,000文字超渡せるみたい。

>Shell sPath & Arg
この前に
Debug.Print sPath & Arg
としてイミディエイトウィンドウにShell関数に渡す文字列をチェックしてみてください。
例えば以下のような結果が出力されます。
"C:\Program Files\Mozilla Thunderbird\thunderbird.exe" -osint -compose mailto:メールアドレス?subject=件名&body=%E3%83%86%E3%82%B9%E3%83%88

対応４）
（３）で指定する為に既定メーラーを取得する必要があります。（上記例ではthunderbird.exe）
既に紹介していますが
http://jehupc.exblog.jp/9727243/
既定メーラーはレジストリ値
"HKEY_CLASSES_ROOT\mailto\shell\open\command\"
を見ると取得できるようです。
そこでWSHのRegReadメソッドとExpandEnvironmentStringsメソッドを利用して取得しています。
http://www.roy.hi-ho.ne.jp/mutaguchi/wsh/
http://www.atmarkit.co.jp/fwin2k/operation/wsh07 …

>'既定メーラー取得(WinXP)
>With CreateObject("WScript.Shell")
>　　sPath = .ExpandEnvironmentStrings(.RegRead(HKEY))
>End With
起動スイッチ『%1』『"%1"』は不要なので削除
>sPath = Replace$(Replace$(sPath, """%1""", ""), "%1", "")

以上のような感じで対応してます。更な詳細はVBA helpやweb検索などで調べてみてください。

この回答へのお礼

詳細な説明をわかりやすくしてくださりありがとうございます。

自分のExcel2007とＯutlookの環境ではうまくいっていたのですが、昨日、他の人にも試してもらったらExcel2003で本文に一部ダブルクオートが入ってしまうと言われました。

まったく同じように操作しているのに環境によって違うのでしょうか？

お礼日時：2010/07/06 08:57

No.2 回答者： end-u 回答日時： 2010/06/20 23:55

ええと、現状のコード提示があればもっと適切なアドバイスができてたかもしれませんね。

>改行もされず本文が全部つながってしまい...
>２千文字くらいしか入らないみたい...
>通常使うメーラーが自動的に立ち上がるような形にしたい...
との記述から推測するとmailtoコマンドを使ったものなのでしょう。

既定メーラーで、かつ改行問題までの対応なら

Sub try_2()
　　Dim tmp, ary
　　Dim wrk As String
　　Dim i As Long
　　Dim x

　　If TypeName(Selection) <> "Range" Then Exit Sub

　　tmp = Selection.Value
　　If IsArray(tmp) Then
　　　　ReDim ary(1 To UBound(tmp))
　　　　For i = 1 To UBound(tmp)
　　　　　　ary(i) = Join(Application.Index(tmp, i, 0), vbTab)
　　　　Next
　　　　wrk = Join(ary, vbLf)
　　Else
　　　　wrk = tmp
　　End If

　　'改行処理
　　wrk = Replace$(wrk, vbLf, "%0a")
　　wrk = "mailto:メールアドレス?" & _
　　　　　"subject=件名&" & _
　　　　　"body=" & wrk
　　CreateObject("WScript.Shell").Run wrk
　　'ShellExecute 0&, "", wrk, "", "", vbNormalFocus
End Sub

こんな感じですが、2,000文字超だと無理です。
CreateProcess関数を使うとできそうな記事もありますがちょっとハードルが高そうです。
http://jehupc.exblog.jp/9751760/

#メーラーを起動させるところで止めるのなら
#DataObjectを使って本文をClipboardにセットして[ctrl][v]でいいような気もしますけども。

ExcelVBAで送信までやるなら以下の方法が近道でしょう。

CDO.Message
http://www.atmarkit.co.jp/fwin2k/win2ktips/428ws …
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

BSMTP.dll
http://www.hi-ho.ne.jp/babaq/index.html
http://www.asahi-net.or.jp/~ef2o-inue/api/sub08_ …

No.1 回答者： end-u 回答日時： 2010/06/18 21:55

DataObject経由ではなく、配列から文字列を繋いでみたらどうでしょう。

メーラーが何かわからないですが、Outlookの場合は以下のような感じ。

Sub try()
　　Const olFolderInbox As Long = 6
　　Const olMailItem As Long = 0
　　Dim obj As Object
　　Dim i　 As Long
　　Dim body, tmp
　　
　　If TypeName(Selection) <> "Range" Then Exit Sub
　　
　　With Selection
　　　　If .Columns.Count = 1 Then
　　　　　　body = Application.Transpose(.Value)
　　　　Else
　　　　　　tmp = .Value
　　　　　　ReDim body(1 To UBound(tmp))
　　　　　　For i = 1 To UBound(tmp)
　　　　　　　　body(i) = Join(Application.Index(tmp, i), vbTab)
　　　　　　Next
　　　　End If
　　End With
　　
　　On Error Resume Next
　　Set obj = GetObject(, "Outlook.Application")
　　On Error GoTo 0
　　If obj Is Nothing Then
　　　　Set obj = CreateObject("Outlook.Application")
　　　　obj.GetNameSpace("MAPI").GetDefaultFolder(olFolderInbox).Display
　　End If
　　
　　With obj.CreateItem(olMailItem)
　　　　.To = "メールアドレス"
　　　　.Subject = "件名"
　　　　.body = Join(body, vbLf)
　　　　.Display
　　End With

　　Erase body
　　Set obj = Nothing
End Sub

この回答への補足

数人で使おうと思っていますが、
人によってメーラーはまちまちで特に決まっていなくて、
できれば通常使うメーラーが自動的に立ち上がるような形にしたいと思っています。

ちょっとよく分かっていないのですが、
配列に入れれば問題は解決するのでしょうか？

補足日時：2010/06/19 12:41

この回答へのお礼

すみません、しばらく忙しくて体調も悪く、
おしえてgooにＰＣから投稿出来ない状態が続いていたのでお礼が遅くなってしまいました。

おしえていただいた方法でなんとか目的のものを作ることが出来ました。

まだちょっとよくわからないところもありますがありがとうございました。

お礼日時：2010/07/01 20:53