編集履歴

質問編集履歴

修正

2022/11/13 11:40

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -26,135 +26,7 @@
           End If
           Next
-### 該当のソースコード
-```ここに言語を入力
-sub メール通知()
-Dim objOutlookApp As Object
-Dim objMail As Object
-Dim Rng As Range
-Dim intintNum As Integer
-Dim strBody As String
-Dim strTag1 As String
-Dim strTag2 As String
-Dim strTag3 As String
-Dim strTag4 As String
-Dim strTag5 As String
-Dim strBr As String
-Dim strSubject As String
-Dim strSTname_Template As String
-strBr = vbLf '改行コード
-'「メール」シートのA列最終行まで処理を繰り返します。
-For intNum = 3 To Worksheets(2).Cells(1048576, 1).End(xlUp).Row + 1
- '「メール」シートのA列載せるに値があればメール作成・送信処理を継続します。
-    If Worksheets(1).Cells(intNum, 1) <> "" Then
-'メールテンプレートを設定します。
-        strSTname_Template = Worksheets(1).Range("B1").Value
- 'メールテンプレートの指定が無い場合は警告表示および処理を中断します。
-        If strSTname_Template = "" Then
-            MsgBox "B" & intNum & "にテンプレートシートを指定してください。"
-            Exit Sub
-        End If
-  'Outlook.Applicationを呼び出し、セットします。
-        Set objOutlookApp = CreateObject("Outlook.Application")
-        Set objMail = objOutlookApp.CreateItem(olMailItem)
- 'メール宛先・本文シート記載の値を変数に入れます。
-        strTag1 = Worksheets(1).Range("G" & intNum).Text
-        strTag2 = Worksheets(1).Range("C" & intNum).Text
-        strTag3 = Worksheets(1).Range("D" & intNum).Text
-        strTag4 = Worksheets(1).Range("E" & intNum).Text
-        strTag5 = Worksheets(1).Range("F" & intNum).Text
- 'テンプレートのメール本文の箇所を読み込み、変数に入れます。
-        For Each Rng In Worksheets(strSTname_Template).Range(Worksheets(strSTname_Template).Range("A5").Value)
-            strBody = strBody & Rng.Value & vbLf
-        Next Rng
- 'メール本文中のタグを指定データへ置換します。
-        strBody = Replace(strBody, "<Tag1>", strTag1)
-        strBody = Replace(strBody, "<Tag2>", strTag2)
-        strBody = Replace(strBody, "<Tag3>", strTag3)
-        strBody = Replace(strBody, "<Tag4>", strTag4)
-        strBody = Replace(strBody, "<Tag5>", strTag5)
-                With objMail
-            .BodyFormat = ２ ' 「3」の場リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
-            .To = Worksheets(1).Range("H" & intNum).Value
-            .CC = Worksheets(1).Range("I" & intNum).Value
-  '本文をBodyプロパティにセットします。
-            .Body = Worksheets(1).Range("C" & intNum).Value & strBr & Worksheets(1).Range("D" & intNum).Value & strBr & strBr & strBody
- 'テンプレートからタイトルを読み込みます。
-            strSubject = Worksheets(strSTname_Template).Range("A2").Value
- 'タグ部分を置換します。
-            strSubject = Replace(strSubject, "<Tag1>", strTag1)
-            strSubject = Replace(strSubject, "<Tag2>", strTag2)
-            strSubject = Replace(strSubject, "<Tag3>", strTag3)
-            strSubject = Replace(strSubject, "<Tag4>", strTag4)
-            strSubject = Replace(strSubject, "<Tag5>", strTag5)
-Worksheets(1).Select
-               Dim i As Variant
-                Dim LastRow As Variant
-                LastRow = Range("A1048576").End(xlUp).Row
-                For i = 3 To LastRow
-                If Cells(i, 3) = "S" Then
-                objMail.Body = strBody
-                objMail.HTMLBody = objMail.HTMLBody & "注意事項1<br>" & _
-                "ご利用いただく際の注意事項について説明します。"
-                ElseIf Cells(i, 3) = "M" Then
-                objMail.HTMLBody = objMail.HTMLBody & "注意事項2<br>" & _
-                "ご利用いただく際の注意事項について説明します。"
-                Else
-                objMail.Body = strBody
-                objMail.HTMLBody = objMail.HTMLBody & "注意事項3<br>" & _
-                "ご利用いただく際の注意事項について説明します。"
-                End If
-                Next
- .Subject = strSubject
-Select Case Worksheets(1).Cells(intNum, 1)
-            Case "未"
-                'メールを表示します。
-                .Display
-            Case Else
-                MsgBox "値が異なります。「未」か「済」を入力してください。"
-End Select
-End With
-        'メール本文をクリアします。
-        strBody = ""
-End If
-Next intNum
-MsgBox "メール作成が完了しました。"
-Set objOutlookApp = Nothing
-Set objMail = Nothing
-End sub
-```

VBA Excel

修正

2022/11/11 03:09

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -2,8 +2,6 @@
 Excel VBAにてOutlookメールを作成したい。
 ### 発生している問題・エラーメッセージ
-https://teratail.com/questions/bfypv5atzbo1vt
-の質問に関連して教えてください。記載する文言がどんどん長く10行くらいになり、改行を入れたいと思い brやvbLfなどを試しましたが改行されず一行で記載されてしまいます。
 どのように改行コードを入れたらいいかがわかりません。
 ### 試したこと

VBA Excel

修正

2022/11/11 03:08

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -5,10 +5,6 @@
 https://teratail.com/questions/bfypv5atzbo1vt
 の質問に関連して教えてください。記載する文言がどんどん長く10行くらいになり、改行を入れたいと思い brやvbLfなどを試しましたが改行されず一行で記載されてしまいます。
 どのように改行コードを入れたらいいかがわかりません。
-![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/9c35cec6-8ae1-40d9-b88f-99e5c94b49da.png)
-![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/f33d36f8-813f-494b-af7f-992785dc1eae.png)
 ### 試したこと
 vbLfなどを色々と試しましたが、一行で表示されてしまいます。

VBA Excel

修正

2022/11/10 08:48

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -161,6 +161,6 @@
 End sub
 ```
-![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-10/495617c0-3575-4001-bad7-781465bd066b.png)

VBA Excel

修正

2022/11/10 08:39

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -109,24 +109,28 @@
             strSubject = Replace(strSubject, "<Tag4>", strTag4)
             strSubject = Replace(strSubject, "<Tag5>", strTag5)
-Worksheets(1).Select
+Worksheets(1).Select
- Dim i As Long
+               Dim i As Variant
-          Dim LastRow As Long
+                Dim LastRow As Variant
-          LastRow = Range("A1048576").End(xlUp).Row
+                LastRow = Range("A1048576").End(xlUp).Row
-          For i = 3 To LastRow
+                For i = 3 To LastRow
-          If Cells(i, 3) = "S" Then
+                If Cells(i, 3) = "S" Then
-          objMail.Body = strBody
+                objMail.Body = strBody
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項 <br>" & _
+                objMail.HTMLBody = objMail.HTMLBody & "注意事項1<br>" & _
-           "ご利用いただく際の注意事項について説明します。"
+                "ご利用いただく際の注意事項について説明します。"
-          ElseIf Cells(i, 3) = "M" Then
+                ElseIf Cells(i, 3) = "M" Then
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項2 <br>" & _
+                objMail.HTMLBody = objMail.HTMLBody & "注意事項2<br>" & _
-          "ご利用いただく際の注意事項について説明します｡ "
+                "ご利用いただく際の注意事項について説明します。"
-          Else
+                Else
+                objMail.Body = strBody
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項3 <br>" & _
+                objMail.HTMLBody = objMail.HTMLBody & "注意事項3<br>" & _
-          "ご利用いただく際の注意事項について説明します｡ "
+                "ご利用いただく際の注意事項について説明します。"
-          End If
+                End If
-          Next
+                Next
  .Subject = strSubject

VBA Excel

修正

2022/11/10 07:53

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -157,6 +157,6 @@
 End sub
 ```
+![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-10/495617c0-3575-4001-bad7-781465bd066b.png)

VBA Excel

修正

2022/11/09 08:02

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -108,24 +108,23 @@
             strSubject = Replace(strSubject, "<Tag3>", strTag3)
             strSubject = Replace(strSubject, "<Tag4>", strTag4)
             strSubject = Replace(strSubject, "<Tag5>", strTag5)
+Worksheets(1).Select
  Dim i As Long
           Dim LastRow As Long
           LastRow = Range("A1048576").End(xlUp).Row
           For i = 3 To LastRow
           If Cells(i, 3) = "S" Then
+          objMail.Body = strBody
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          objMail.HTMLBody = objjMail.HTMLBody & "注意事項 <br>" & _
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら1</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
+           "ご利用いただく際の注意事項について説明します。"
-         ElseIf Cells(i, 3) = "M" Then
+          ElseIf Cells(i, 3) = "M" Then
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項2" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          objMail.HTMLBody = objjMail.HTMLBody & "注意事項2 <br>" & _
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら2</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら2</a>"
+          "ご利用いただく際の注意事項について説明します｡ "
           Else
-           objMail.Body = strBody
-           objMail.HTMLBody = objjMail.HTMLBody & "注意事項3" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          objMail.HTMLBody = objjMail.HTMLBody & "注意事項3 <br>" & _
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら3</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら3</a>"
+          "ご利用いただく際の注意事項について説明します｡ "
           End If
           Next

VBA Excel

修正

2022/11/08 10:59

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -3,7 +3,7 @@
 ### 発生している問題・エラーメッセージ
 https://teratail.com/questions/bfypv5atzbo1vt
-の質問に関連して教えてください。記載する文言がどんどん長く10行くらいになり、改行を入れたいと思い <br>や<vbLf>などを試しましたが改行されず一行で記載されてしまいます。
+の質問に関連して教えてください。記載する文言がどんどん長く10行くらいになり、改行を入れたいと思い brやvbLfなどを試しましたが改行されず一行で記載されてしまいます。
 どのように改行コードを入れたらいいかがわかりません。
 ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/9c35cec6-8ae1-40d9-b88f-99e5c94b49da.png)
@@ -11,7 +11,7 @@
 ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/f33d36f8-813f-494b-af7f-992785dc1eae.png)
 ### 試したこと
-<vbLf>などを色々と試しましたが、一行で表示されてしまいます。
+vbLfなどを色々と試しましたが、一行で表示されてしまいます。
  Dim i As Long
           Dim LastRow As Long
           LastRow = Range("A1048576").End(xlUp).Row
@@ -19,8 +19,7 @@
           If Cells(i, 3) = "S" Then
           objMail.HTMLBody = objjMail.HTMLBody & "注意事項" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
           ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら1</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
+          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
           ElseIf Cells(i, 3) = "M" Then
           objMail.HTMLBody = objjMail.HTMLBody & "注意事項2" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
           ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら2</a>" & vbLf & "
@@ -34,6 +33,8 @@
           Next
 ### 該当のソースコード
+```ここに言語を入力
 sub メール通知()
 Dim objOutlookApp As Object
 Dim objMail As Object
@@ -54,64 +55,61 @@
 '「メール」シートのA列最終行まで処理を繰り返します。
 For intNum = 3 To Worksheets(2).Cells(1048576, 1).End(xlUp).Row + 1
-    '「メール」シートのA列載せるに値があればメール作成・送信処理を継続します。
+ '「メール」シートのA列載せるに値があればメール作成・送信処理を継続します。
     If Worksheets(1).Cells(intNum, 1) <> "" Then
-        'メールテンプレートを設定します。
+'メールテンプレートを設定します。
         strSTname_Template = Worksheets(1).Range("B1").Value
-        'メールテンプレートの指定が無い場合は警告表示および処理を中断します。
+ 'メールテンプレートの指定が無い場合は警告表示および処理を中断します。
         If strSTname_Template = "" Then
             MsgBox "B" & intNum & "にテンプレートシートを指定してください。"
             Exit Sub
         End If
-        'Outlook.Applicationを呼び出し、セットします。
+  'Outlook.Applicationを呼び出し、セットします。
         Set objOutlookApp = CreateObject("Outlook.Application")
         Set objMail = objOutlookApp.CreateItem(olMailItem)
-        'メール宛先・本文シート記載の値を変数に入れます。
+ 'メール宛先・本文シート記載の値を変数に入れます。
         strTag1 = Worksheets(1).Range("G" & intNum).Text
         strTag2 = Worksheets(1).Range("C" & intNum).Text
         strTag3 = Worksheets(1).Range("D" & intNum).Text
         strTag4 = Worksheets(1).Range("E" & intNum).Text
         strTag5 = Worksheets(1).Range("F" & intNum).Text
-        'テンプレートのメール本文の箇所を読み込み、変数に入れます。
+ 'テンプレートのメール本文の箇所を読み込み、変数に入れます。
         For Each Rng In Worksheets(strSTname_Template).Range(Worksheets(strSTname_Template).Range("A5").Value)
             strBody = strBody & Rng.Value & vbLf
         Next Rng
-        'メール本文中のタグを指定データへ置換します。
+ 'メール本文中のタグを指定データへ置換します。
         strBody = Replace(strBody, "<Tag1>", strTag1)
         strBody = Replace(strBody, "<Tag2>", strTag2)
         strBody = Replace(strBody, "<Tag3>", strTag3)
         strBody = Replace(strBody, "<Tag4>", strTag4)
         strBody = Replace(strBody, "<Tag5>", strTag5)
-        With objMail
+                With objMail
             .BodyFormat = ２ ' 「3」の場リッチテキスト型となります。「1」はテキスト型、「2」は HTML型となります。
             .To = Worksheets(1).Range("H" & intNum).Value
             .CC = Worksheets(1).Range("I" & intNum).Value
-            '本文をBodyプロパティにセットします。
+  '本文をBodyプロパティにセットします。
             .Body = Worksheets(1).Range("C" & intNum).Value & strBr & Worksheets(1).Range("D" & intNum).Value & strBr & strBr & strBody
-            'テンプレートからタイトルを読み込みます。
+ 'テンプレートからタイトルを読み込みます。
             strSubject = Worksheets(strSTname_Template).Range("A2").Value
-            'タグ部分を置換します。
+ 'タグ部分を置換します。
             strSubject = Replace(strSubject, "<Tag1>", strTag1)
             strSubject = Replace(strSubject, "<Tag2>", strTag2)
             strSubject = Replace(strSubject, "<Tag3>", strTag3)
             strSubject = Replace(strSubject, "<Tag4>", strTag4)
             strSubject = Replace(strSubject, "<Tag5>", strTag5)
-          Dim i As Long
+ Dim i As Long
           Dim LastRow As Long
           LastRow = Range("A1048576").End(xlUp).Row
           For i = 3 To LastRow
@@ -132,24 +130,24 @@
           Next
-            .Subject = strSubject
+ .Subject = strSubject
-            Select Case Worksheets(1).Cells(intNum, 1)
+Select Case Worksheets(1).Cells(intNum, 1)
             Case "未"
                 'メールを表示します。
                 .Display
             Case Else
                 MsgBox "値が異なります。「未」か「済」を入力してください。"
-            End Select
+End Select
-        End With
+End With
         'メール本文をクリアします。
         strBody = ""
-    End If
+End If
 Next intNum
@@ -159,6 +157,7 @@
 Set objMail = Nothing
 End sub
+```

VBA Excel

修正

2022/11/08 10:53

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -9,7 +9,30 @@
 ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/9c35cec6-8ae1-40d9-b88f-99e5c94b49da.png)
 ![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-08/f33d36f8-813f-494b-af7f-992785dc1eae.png)
+### 試したこと
+<vbLf>などを色々と試しましたが、一行で表示されてしまいます。
+ Dim i As Long
+          Dim LastRow As Long
+          LastRow = Range("A1048576").End(xlUp).Row
+          For i = 3 To LastRow
+          If Cells(i, 3) = "S" Then
+          objMail.HTMLBody = objjMail.HTMLBody & "注意事項" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら1</a>" & vbLf & "
+          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
+          ElseIf Cells(i, 3) = "M" Then
+          objMail.HTMLBody = objjMail.HTMLBody & "注意事項2" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら2</a>" & vbLf & "
+          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら2</a>"
-```
+          Else
+           objMail.Body = strBody
+           objMail.HTMLBody = objjMail.HTMLBody & "注意事項3" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
+          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら3</a>" & vbLf & "
+          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら3</a>"
+          End If
+          Next
 ### 該当のソースコード
 sub メール通知()
 Dim objOutlookApp As Object
@@ -135,29 +158,7 @@
 Set objOutlookApp = Nothing
 Set objMail = Nothing
 End sub
-```
-### 試したこと
-<vbLf>などを色々と試しましたが、一行で表示されてしまいます。
- Dim i As Long
-          Dim LastRow As Long
-          LastRow = Range("A1048576").End(xlUp).Row
-          For i = 3 To LastRow
-          If Cells(i, 3) = "S" Then
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら1</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
-          ElseIf Cells(i, 3) = "M" Then
-          objMail.HTMLBody = objjMail.HTMLBody & "注意事項2" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら2</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら2</a>"
-          Else
-           objMail.Body = strBody
-           objMail.HTMLBody = objjMail.HTMLBody & "注意事項3" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
-          ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら3</a>" & vbLf & "
-          その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら3</a>"
-          End If
-          Next

VBA Excel

修正

2022/11/08 10:51

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -96,8 +96,7 @@
           objMail.HTMLBody = objjMail.HTMLBody & "注意事項" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
           ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら1</a>" & vbLf & "
           その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら1</a>"
-          ElseIf Cells(i, 3) = "M" Then
+         ElseIf Cells(i, 3) = "M" Then
           objMail.HTMLBody = objjMail.HTMLBody & "注意事項2" & vbLf & "ご利用いただく際の注意事項について説明します。" & vbLf & "
           ご利用いただくにあたっての注意事項の詳細は <a href=""https://www.google.co.jp/"">こちら2</a>" & vbLf & "
           その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら2</a>"
@@ -108,11 +107,10 @@
           その他サービスをご利用いただくための注意事項は<a href=""https://www.google.co.jp/"">こちら3</a>"
           End If
           Next
             .Subject = strSubject
             Select Case Worksheets(1).Cells(intNum, 1)
             Case "未"

VBA Excel

修正

2022/11/08 10:50

投稿

koko2

スコア21

test CHANGED Viewed

File without changes

test CHANGED Viewed

@@ -138,6 +138,8 @@
 Set objMail = Nothing
 End sub
 ```
 ### 試したこと
 <vbLf>などを色々と試しましたが、一行で表示されてしまいます。
  Dim i As Long

VBA Excel