VBAで【Thunderbird】を起動させメール作成したい

エクセルのVBAを使ってフリーのメールソフト【Thunderbird】を起動させ、
メールを作成したいと思っています。

下記コード（１）でエクセルからメール作成はできます。
★やりたいことは
エクセルの固定シート「メール文面」のA列に記載した文面をメール本文に貼付たいです。

　コード（１）の
mailBody = "てすとｗ%0aてすと"
mailBody =　に「メール文面」シートの内容を貼り付けたいです。

　例えば、メモ帳を起動させ、貼り付ける。⇒コード（２）でできます。
うまく、【Thunderbird】のメール本文に貼り付けられませんか？
コード（１）をどのように書き換えれば、可能か御教示下さい。

●コード（１）

Public Sub メール作成()

  Dim tbPath As String
  tbPath = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
  tbPath = """" & tbPath & """ -compose """
  
  Dim mailTo As String
  mailTo = "hoge@foo.bar.jp;fuga@foo.bar.jp"
  
  Dim mailSubj As String
  mailSubj = "てすと"
  
  Dim mailBody As String
  mailBody = "てすとｗ%0aてすと"
   
  Dim strAttFile As String
  strAttFile = "添付ファイルフルパス"
  
  Shell tbPath & _
    "to=" & mailTo & "," & _
    "subject=""" & mailSubj & """," & _
    "body=""" & mailBody & """," & _
    "attachment=""" & strAttFile & """"

End Sub

●コード（２）

Sub メモ帳貼付()

Dim ws As Worksheet
Dim ret As Long, maxrow As Long
    
    Set ws = Sheets("メール文面")
    
    With ws
        maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(maxrow, 1)).Copy
        ret = Shell("Notepad.Exe", vbNormalFocus)
        AppActivate ("無題 - メモ帳")
        CreateObject("Wscript.Shell").SendKeys "^v"
        Application.CutCopyMode = False
    End With
    
End Sub

行動規範の内容に同意します

回答3件

SendKeyに頼ると、意図しない結果になるリスクがあり不安です。

可能であればOutLookをVBAで操作した方が無難かと。(Excelから起動＋操作可能なはずです)

投稿2018/03/14 05:44

ExcelVBAer

総合スコア1175

ベストアンサー

bodyオプション（mailBody変数）に本文を指定するのはご存知のようなので、そこの編集だけやってあげればよいように思います。
ただ改行を考慮しないといけないようですので、以下の記事を参考にしました。
https://forums.mozillazine.jp/viewtopic.php?t=9506
手元に環境がないのでこれでいけるのかはわかりませんが、お試しください。
尚、リンク先ではvbCrLfを%0d%0aに置き換えているようですが、私の環境ではvbLfでした。

VBA
1Dim maxrow As Long
2Dim rg As Range
3Dim mailBody As String
4
5' A列の値を結合
6With Sheets("メール文面")
7    maxrow = .Cells(Rows.Count, 1).End(xlUp).Row
8    Set rg = .Range(.Cells(1, 1), .Cells(maxrow, 1))
9    mailBody = ""
10    For Each c In rg
11        mailBody = mailBody & c & "%0d%0a"
12    Next
13End With
14' セル内改行を考慮
15'mailBody  = Replace(mailBody , vbCrLf, "%0d%0a")
16'mailBody  = Replace(mailBody , vbCr, "%0d%0a")
17mailBody = Replace(mailBody, vbLf, "%0d%0a")