ExcelのVBAスクリプトは、1つのセルのデータを複数のセルにメールします。

Question

Ron de Bruinのスクリプトを使用して、電子メールアドレスを持つすべてのシートを指定されたセルのアドレスに送信します。これは、シートを添付ファイルとして送信することを意味していますが、メールの本文にあるセルからデータを送信したいだけです。私は添付ファイルを送信する部分をコメントアウトし、電子メールの本文にある1つのセルのデータを含む電子メールを送信することができました。しかし、複数のセルからデータを送信しようとすると、電子メールは空白になります。私はプロのVBAじゃないので、私は彼のサイトからヒントを使用していますし、これは動作するはずのように見えるが、それはしません。

Sub Mail_Every_Worksheet() 
'Working in Excel 2000-2016 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
Dim sh As Worksheet 
Dim wb As Workbook 
Dim FileExtStr As String 
Dim FileFormatNum As Long 
Dim TempFilePath As String 
Dim TempFileName As String 
Dim OutApp As Object 
Dim OutMail As Object 

TempFilePath = Environ$("temp") & "\" 

If Val(Application.Version) < 12 Then 
    'You use Excel 97-2003 
    FileExtStr = ".xls": FileFormatNum = -4143 
Else 
    'You use Excel 2007-2016 
    FileExtStr = ".xlsm": FileFormatNum = 52 
End If 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

Set OutApp = CreateObject("Outlook.Application") 

For Each sh In ThisWorkbook.Worksheets 
    If sh.Range("B1").Value Like "?*@?*.?*" Then 

     sh.Copy 
     Set wb = ActiveWorkbook 

     TempFileName = "Sheet " & sh.Name & " of " _ 
        & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") 

     Set OutMail = OutApp.CreateItem(0) 

     With wb 
      .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum 

      On Error Resume Next 
      With OutMail 
       .To = sh.Range("B1").Value 
       .CC = "" 
       .BCC = "" 
       .Subject = "Monthly Shirt Sales" 
       Dim cell As Range 
       Dim strbody As String 
       For Each cell In 
       ThisWorkbook.Sheets("Sheet1").Range("A4:A36") 
       strbody = strbody & cell.Value & vbNewLine 
       Next 
       '.Attachments.Add wb.FullName 
       'You can add other files also like this 
       '.Attachments.Add ("C:\test.txt") 
       .Send 'or use .Display 
      End With 
      On Error GoTo 0 

      .Close savechanges:=False 
     End With 

     Set OutMail = Nothing 

     Kill TempFilePath & TempFileName & FileExtStr 

    End If 
Next sh 

Set OutApp = Nothing 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 
End Sub 

私は

を交換するとき、これは、1つのセルにデータを送信するために動作しますこれで

Dim cell As Range 
Dim strbody As String 
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A4:A36") 
strbody = strbody & cell.Value & vbNewLine 
Next 

：

.Body = sh.Range("A4").Value 

ので、私はこれを使用するとうまくいくことを考えた：

.Body = sh.Range("A4:B36").Value 

でも、空のメールが送信されます。

誰もが複数のセルからデータを送信しない理由を教えてもらえますか？

ありがとうございました！

Answer 1

範囲をループし、次の例のような範囲の値を組み合わせる必要があります。

Dim strbody As String 

For Each cell In sh.Range("A1:B2") 
    strbody = strbody & cell.Value & vbNewLine 
Next cell 

はThenステートメント

With OutMail 
    .To = sh.Range("B1").Value 
    .CC = "" 
    .BCC = "" 
    .Subject = "Monthly Shirt Sales" 
    .Body = strbody 
    .send 'or use .Display 
End With