「ブロック機能」のリニューアルについて

お詳しい方 ご教授をお願いします。

下記のコードを組んだのですが、メールをHDML形式で本文にどうしても指定セルのURLをリンク状態で記載されませ。

例としてセルB11にURL先が記載されているという条件でどうのようにコードを組むか
アドバイスを頂けないでしょうか。

Sub sumple1_Click()

'To 抽出~メール起動------------------------------------------------------

Dim oApp As Object

Dim oMail As Object

Dim i As Long, tmpto As String

Application.ScreenUpdating = False

Set oApp = CreateObject("Outlook.Application")

Set oMail = oApp.CreateItem(0)

'宛先

For i = 2 To Cells(Rows.Count, "G").End(xlUp).row

If Range("G" & i).Value <> "" Then

If tmpto = "" Then

tmpto = Range("G" & i).Value

Else

tmpto = tmpto & "," & Range("G" & i).Value

End If

End If

Next i

If tmpto <> "" Then

With oMail

.To = tmpto

'To 抽出終わり----------------------------------------





'件名

.Subject = Range("B9").Value

'本文





'内容抽出-------------------------------------------



.Body = Range("B10").Value





.Display '表示

'.Send '送信



End With

End If

Application.ScreenUpdating = True


End Sub

質問者からの補足コメント

  • 回答いただきありがとうございます。Toの宛先ですが最大5名程度を考えていたので BCCについてはなにも考えていませんでした。今後宛先が増えるようでしたら頂いたアドバイスを参考にさせていただきます。 

    また、質問事項について説明不足でしたので、下記に質問事項を追加させてもらいます。

    現在の悩みは
    セル10に本文として下記URLをご参照ください。
    などの定型文が記載されており。
    セル11に対象のURLが記載さている条件で本文に定型文+URLリンクを表示させたいと考えています。 この併せて表示というのがなかなかうまくいかず難儀しています。

      補足日時:2022/08/08 10:01
  • アドバイスありがとうございます。

    ご教授いただいたコードをそのまま反映させたところ本文とURLは連結して表示がされるようになったのですが、セルB11のURLが本文では青字(リンク状態)にどうしてもなりませんでした。

    連結させる際のコードをもう少し弄ればいけそうな気がしますが、色々自分なりに努力したのですが、なかなかうまくいかず・・
    もしよろしければ、不具合についてアドバイスを頂けると助かります。

      補足日時:2022/08/09 13:03
教えて!goo グレード

A 回答 (8件)

こんばんは。



>セルB11のURLが本文では青字(リンク状態)にどうしてもなりませんでした。

Outlook のオプション設定で、ディフォルトのメール形式がテキストに設定してあるんだと思いますよ。
全体を再掲します。下記のソースでお試し下さい。

 # HTMLソースをVBAで書くのは面倒なので
 # リンクはOutlookにまかせてます

Sub sumple1_Click()

  'Outlook/CreateObject 定数
  Const olMailItem = 0  'メール
  'Outlook/CreateItem 定数
  Const olFormatPlain = 1 'テキスト形式メール
  Const olFormatHTML = 2 'HTML形式メール
 
  'To抽出 -----------------------------------------------

  Dim i   As Long
  Dim tmpto As String

  '宛先
  For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
    If Range("G" & i).Value <> "" Then
      If tmpto = "" Then
        tmpto = Range("G" & i).Value
      Else
        '■↓変更 アドレス区切り文字は「;」
        tmpto = tmpto & ";" & Range("G" & i).Value
      End If
    End If
  Next i

  If Len(tmpto) = 0 Then Exit Sub '宛先がなければ終了
  
  '本文を作成 -------------------------------------------
  Dim body_text As String
  body_text = Range("B10").Value _
       & Range("B11").Value

  'Outlookを起動してメール作成 --------------------------
 
  Dim oApp  As Object 'Outlook.Application
  Dim oMail As Object 'Outlook.MailItem
  Set oApp = CreateObject("Outlook.Application")
  Set oMail = oApp.CreateItem(olMailItem)
  With oMail
    .BodyFormat = olFormatHTML   '<--■追加 HTML形式
    .To = tmpto           '宛先
    .Subject = Range("B9").Value  '件名
    .Body = body_text        '本文
    .Display            'ブレビュー
    '.Send              '送信
  End With

  '他アプリを操作したらオブジェクトを必ず破棄
  'オートメーションエラーの原因になります
 
  Set oMail = Nothing
  Set oApp = Nothing

End Sub
    • good
    • 0
この回答へのお礼

アドバイスありがとうございました。 なんとかなりそうです。

お礼日時:2022/08/10 17:44

おおー、ごめんなさい。


投稿したのが消えたと思って同じ内容投稿しちゃいました。
    • good
    • 0

URL をリンクにするだけなら別にHTMLメール形式にする必要はなく、テキスト形式で大丈夫ですよ。

    • good
    • 0

URLリンクだけなら HTML メールである必要はありませんね。


テキスト形式でも URL はリンクになります。

補足からご質問での実現したい事の課題は、複数のセルにある値をいかに連結するかにあると判断しました。

テキストはB10またはB11セルにあるそうですが、VBAソースからはその痕跡が見られなかったので。

余談ですが、改行コード vbNewline は Windows だと vbCrLf と同意です。
    • good
    • 0

こんにちは


>HTMLメールを本文にどうしても指定セルのURLをリンク状態で記載されませ。

HTML形式の例

'To 抽出終わり----------------------------------------
Dim strHTML As String
If tmpto <> "" Then
If Range("B11") <> "" Then
strHTML = Range("B10").Text & "<br>" _
& "<a href=" & Range("B11").Text & "> 参考URL</a>"
Else
strHTML = Range("B10").Text & "</a>"
End If

With oMail
'件名
.Subject = Range("B9").Value
.To = tmpto
.CC = ""
'本文
.HTMLBody = "<b>宛先各位</b>" _
& "<br><br>" _
& " 初めに" _
& "<br><br>" _
& "要件<br>" _
& strHTML _
& "<br><br>" _
& "<a href=""https://oshiete.goo.ne.jp/qa/13084470.html"">教えて!goo</a>"
'.Attachments.Add ("C:\Users\xx\添付ファイル.pdf")
.Display '表示
'.Send '送信
End With
End If


If Range("B11") <> "" Thenの条件は適当
文字列作成 (文字列 改行 リンク文字(非表示) 表示文字)
strHTML = Range("B10").Text & "<br>" _
& "<a href=" & Range("B11").Text & "> 参考URL</a>"

URLだけを表示したい場合は
strHTML = Range("B10").Text & "<br>" _
& "<a href=" & Range("B11").Text & ">" & Range("B11").Text & "</a>"
    • good
    • 0

ごめんなさい。


レイトバインドなの忘れてました。#2の下記部分を差し替えて下さい

  Dim oApp  As Outlook.Application ' Object
  Dim oMail As Outlook.MailItem  ' Object

     ↓

  Dim oApp As Object
  Dim oMail As Object
    • good
    • 0

HTML で本文を書いてない=テキスト形式メールであるなら


→#1 ■VBA ソースについて はスルーして下さい

>この併せて表示というのがなかなかうまくいかず難儀しています。

単純に文字列を連結して Body に指定すれば良いと思いますよ。
改行は vbNewline です。ソース全体を少し直しました。

Sub sumple1_Click()

  'Outlook/CreateObject 定数
  Const olMailItem = 0  'メール
  'Outlook/CreateItem 定数
  Const olFormatPlain = 1 'テキスト形式メール
  Const olFormatHTML = 2 'HTML形式メール
  
  'To抽出 -----------------------------------------------

  Dim i   As Long
  Dim tmpto As String

  '宛先
  For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
    If Range("G" & i).Value <> "" Then
      If tmpto = "" Then
        tmpto = Range("G" & i).Value
      Else
        tmpto = tmpto & "," & Range("G" & i).Value
      End If
    End If
  Next i

  If Len(tmpto) = 0 Then Exit Sub ’宛先がなければ終了

  'Outlookを起動してメール作成 --------------------------
  
  Dim oApp  As Outlook.Application ' Object
  Dim oMail As Outlook.MailItem  ' Object
  Set oApp = CreateObject("Outlook.Application")
  Set oMail = oApp.CreateItem(olMailItem)

  'B10セル、B11セルの内容を連結して本文作成
  Dim body_text As String
  body_text = Range("B10").Value & vbNewLine _
       & Range("B11").Value
  
  With oMail
    .To = tmpto           '宛先
    .Subject = Range("B9").Value  '件名
    .Body = body_text        '本文
    .Display            'ブレビュー
    '.Send              '送信
  End With

  '重要
  '他アプリを操作したらオブジェクトを必ず破棄
  'オートメーションエラーの原因になります
  
  Set oMail = Nothing
  Set oApp = Nothing

End Sub
    • good
    • 0

こんにちは。



下記ポイントを確認してみて下さい。

■Outlook 側の設定はどうなっていますか?
https://support.microsoft.com/ja-jp/office/f361c …

■一斉配信は、BCC欄(またはCC欄)を通常使います。
 配信数によっては、、ですが、TO欄で大丈夫?
 (例)BCC欄を使う場合  oMail.BCC = tmpto

■VBA ソースについて
下記で試してみて下さい。

'内容抽出-------------------------------------------
.BodyFormat = 2         '追加 2:olFormatHTML
'.Body = Range("B10").Value    '下行に訂正
.HTMLBody = Range("B10").Value 'B10? B11セル?

■最大発信数について
 本件の目的、何件のメール送信になるのかが明記されてません。
 メールプロバイダーは1日で送れるメール最大数を定めています。
 これは迷惑メール防止、サーバーへの過度な負荷予防の観点から。
 この点、問題はありませんか?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング