teratail
回答率
85.30%
質問するログイン新規登録
トップに関する質問VBA　メールの送り方について

編集履歴

質問編集履歴

11

2021/10/31 02:51

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -56,6 +56,10 @@
56
56
  End If
57
57
  If InStr(s, "INS") Then
58
58
  f1 = True
59
+ mailTo = "b230420"
60
+ End If
61
+ If InStr(s, "専用") Then
62
+ f1 = True
59
63
  mailTo = "aquarius0319"
60
64
  End If
61
65
 

10

2021/10/31 02:51

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -56,7 +56,7 @@
56
56
  End If
57
57
  If InStr(s, "INS") Then
58
58
  f1 = True
59
- mailTo = "b230420"
59
+ mailTo = "aquarius0319"
60
60
  End If
61
61
 
62
62
  If InStr(s, "秋田") And r < tb.Rows.Count Then

9

2021/10/31 02:49

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,4 +1,4 @@
1
- 修正しました
1
+ 再度修正しました
2
2
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
3
3
 
4
4
  ```VBA

8

2021/10/31 02:39

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,6 +1,7 @@
1
1
  修正しました
2
2
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
3
+
3
- コード
4
+ ```VBA
4
5
  Sub 最終sample()
5
6
  Const olMailItem = 0
6
7
  Dim file As String
@@ -106,7 +107,4 @@
106
107
  ol.Quit
107
108
 
108
109
  End Sub
109
-
110
- VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
111
-
112
110
  ```

7

2021/10/31 02:39

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,3 +1,4 @@
1
+ 修正しました
1
2
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
3
  コード
3
4
  Sub 最終sample()

6

2021/10/31 02:18

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,4 +1,4 @@
1
- ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
1
+ VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
2
  コード
3
3
  Sub 最終sample()
4
4
  Const olMailItem = 0

5

2021/10/31 02:17

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,110 +1,111 @@
1
1
  ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
+ コード
3
+ Sub 最終sample()
4
+ Const olMailItem = 0
5
+ Dim file As String
6
+ Dim pr As Presentation
7
+ Dim sl As Slide
8
+ Dim sh As Shape
9
+ Dim tb As Table
10
+ Dim r As Integer
11
+ Dim c As Integer
12
+ Dim s As String
13
+ Dim t As String
2
14
 
15
+ Dim f1 As Boolean
16
+ Dim f2 As Boolean
17
+ Dim ol As Object
3
- コード```Sub 最終sample()
18
+ Dim mail As Object
19
+ Dim f As Object
20
+ Dim dic As Object
4
- Const olMailItem = 0
21
+ Dim k As Variant
22
+ Dim n As Variant
5
- Dim file As String
23
+ Dim mailTo As String
6
- Dim pr As Presentation
7
- Dim sl As Slide
8
- Dim sh As Shape
9
- Dim tb As Table
10
- Dim r As Integer
11
- Dim c As Integer
12
- Dim s As String
13
- Dim t As String
14
24
 
25
+ With Application.FileDialog(msoFileDialogOpen)
15
- Dim f1 As Boolean
26
+ .Filters.Clear
27
+ .Filters.Add "ppt", "*.ppt?"
16
- Dim f2 As Boolean
28
+ .InitialFileName = "C:\"
17
- Dim ol As Object
29
+ .AllowMultiSelect = False
30
+ If Not .Show Then Exit Sub
18
- Dim mail As Object
31
+ file = .SelectedItems(1)
19
- Dim f As Object
20
- Dim dic As Object
21
- Dim k As Variant
22
- Dim n As Variant
32
+ End With
23
- Dim mailTo As String
24
33
 
34
+ Do
25
- With Application.FileDialog(msoFileDialogOpen)
35
+ Set pr = Presentations.Open(file)
36
+ For Each sl In pr.Slides
37
+ f1 = False
38
+ f2 = False
39
+ For Each sh In sl.Shapes
40
+ If sh.HasTable Then
26
- .Filters.Clear
41
+ Set tb = sh.Table
42
+ For r = 1 To tb.Rows.Count
43
+ For c = 1 To tb.Rows(r).Cells.Count
44
+ s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
45
+ t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
46
+ '宛先
27
- .Filters.Add "ppt", "*.ppt?"
47
+ If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
48
+ f1 = True
28
- .InitialFileName = "C:\"
49
+ mailTo = "syunsuke"
29
- .AllowMultiSelect = False
30
- If Not .Show Then Exit Sub
31
- file = .SelectedItems(1)
32
- End With
50
+ End If
51
+ If InStr(s, "フレッツ") Then
52
+ f1 = True
53
+ mailTo = "b230420"
54
+ End If
55
+ If InStr(s, "INS") Then
56
+ f1 = True
57
+ mailTo = "b230420"
58
+ End If
33
59
 
34
- Do
35
- Set pr = Presentations.Open(file)
36
- For Each sl In pr.Slides
37
- f1 = False
38
- f2 = False
39
- For Each sh In sl.Shapes
40
- If sh.HasTable Then
41
- Set tb = sh.Table
42
- For r = 1 To tb.Rows.Count
60
+ If InStr(s, "秋田") And r < tb.Rows.Count Then
43
- For c = 1 To tb.Rows(r).Cells.Count
44
- s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
61
+ If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
45
- t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
46
- '宛先
47
- If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
48
- f1 = True
49
- mailTo = "syunsuke"
50
- End If
62
+ End If
51
- If InStr(s, "フレッツ") Then
63
+ If f1 And f2 Then Exit Do
52
- f1 = True
64
+ Next
53
- mailTo = "b230420"
65
+ Next
54
- End If
66
+ End If
55
- If InStr(s, "INS") Then
56
- f1 = True
57
- mailTo = "b230420"
58
- End If
59
-
60
- If InStr(s, "秋田") And r < tb.Rows.Count Then
61
- If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
62
- End If
63
- If f1 And f2 Then Exit Do
64
- Next
67
+ Next
65
- Next
68
+ Next
66
- End If
67
- Next
68
- Next
69
- MsgBox "無かった"
69
+ MsgBox "無かった"
70
- Loop Until True
70
+ Loop Until True
71
- pr.Close
71
+ pr.Close
72
72
 
73
- If Not (f1 And f2) Then Exit Sub
73
+ If Not (f1 And f2) Then Exit Sub
74
- '
74
+ '
75
- MsgBox "見つけた"
75
+ MsgBox "見つけた"
76
76
 
77
+ Set ol = CreateObject("Outlook.Application")
78
+ Set mail = ol.CreateItem(olMailItem)
79
+ mail.Display
77
80
 
78
- Set ol = CreateObject("Outlook.Application")
81
+ mail.To = mailTo '宛先
79
- Set mail = ol.CreateItem(olMailItem)
82
+ mail.Subject = "件名"
80
- mail.Display
83
+ mail.Body = "本文"
81
84
 
85
+ '添付ファイル
82
- mail.To = mailTo '宛先
86
+ mail.Attachments.Add file
83
- mail.Subject = "件名"
84
- mail.Body = "本文"
85
87
 
86
- '添付ファイル
88
+ '添付ファイル
89
+ With Application.FileDialog(msoFileDialogOpen)
90
+ .Filters.Clear
91
+ .Filters.Add "添付ファイル", "*.*"
92
+ .InitialFileName = "C:\"
93
+ .AllowMultiSelect = True
94
+ If .Show Then
95
+ Dim o As Integer
96
+ For o = 1 To .SelectedItems.Count
87
- mail.Attachments.Add file
97
+ mail.Attachments.Add .SelectedItems(o)
98
+ Next
99
+ End If
100
+ End With
88
101
 
89
- '添付ファイル
102
+ 'メール送信
90
- With Application.FileDialog(msoFileDialogOpen)
91
- .Filters.Clear
103
+ mail.Send '送信
92
- .Filters.Add "添付ファイル", "*.*"
93
- .InitialFileName = "C:\"
94
- .AllowMultiSelect = True
95
- If .Show Then
96
- Dim o As Integer
97
- For o = 1 To .SelectedItems.Count
98
- mail.Attachments.Add .SelectedItems(o)
99
- Next
100
- End If
101
- End With
102
104
 
103
- 'メール送信
105
+ ol.Quit
104
- mail.Send '送信
105
106
 
106
- ol.Quit
107
-
108
107
  End Sub
109
108
 
110
- VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
109
+ VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
110
+
111
+ ```

4

2021/10/31 02:17

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -47,7 +47,6 @@
47
47
  If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
48
48
  f1 = True
49
49
  mailTo = "syunsuke"
50
- mailTo = "aquarius0319"
51
50
  End If
52
51
  If InStr(s, "フレッツ") Then
53
52
  f1 = True

3

2021/10/31 01:18

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,7 +1,6 @@
1
1
  ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
2
 
3
- コード
4
- ```Sub 最終sample()
3
+ コード```Sub 最終sample()
5
4
  Const olMailItem = 0
6
5
  Dim file As String
7
6
  Dim pr As Presentation

2

2021/10/31 01:16

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -1,6 +1,7 @@
1
- VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
1
+ ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
2
 
3
+ コード
3
- Sub 最終sample()
4
+ ```Sub 最終sample()
4
5
  Const olMailItem = 0
5
6
  Dim file As String
6
7
  Dim pr As Presentation

1

文書の変更

2021/10/31 01:16

投稿

shunsuke_0319
shunsuke_0319

スコア2

title CHANGED
File without changes
body CHANGED
@@ -106,4 +106,6 @@
106
106
 
107
107
  ol.Quit
108
108
 
109
- End Sub
109
+ End Sub
110
+
111
+ VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？