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

編集履歴

質問編集履歴

11

2021/10/31 02:51

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -114,6 +114,14 @@
114
114
 
115
115
  f1 = True
116
116
 
117
+ mailTo = "b230420"
118
+
119
+ End If
120
+
121
+ If InStr(s, "専用") Then
122
+
123
+ f1 = True
124
+
117
125
  mailTo = "aquarius0319"
118
126
 
119
127
  End If

10

2021/10/31 02:51

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -114,7 +114,7 @@
114
114
 
115
115
  f1 = True
116
116
 
117
- mailTo = "b230420"
117
+ mailTo = "aquarius0319"
118
118
 
119
119
  End If
120
120
 

9

2021/10/31 02:49

投稿

shunsuke_0319
shunsuke_0319

スコア2

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

8

2021/10/31 02:39

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -2,7 +2,9 @@
2
2
 
3
3
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
4
4
 
5
+
6
+
5
- コード
7
+ ```VBA
6
8
 
7
9
  Sub 最終sample()
8
10
 
@@ -214,10 +216,4 @@
214
216
 
215
217
  End Sub
216
218
 
217
-
218
-
219
- VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
220
-
221
-
222
-
223
219
  ```

7

2021/10/31 02:39

投稿

shunsuke_0319
shunsuke_0319

スコア2

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

6

2021/10/31 02:18

投稿

shunsuke_0319
shunsuke_0319

スコア2

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

5

2021/10/31 02:17

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -1,214 +1,212 @@
1
1
  ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
2
 
3
-
4
-
5
- コード```Sub 最終sample()
6
-
7
- Const olMailItem = 0
8
-
9
- Dim file As String
10
-
11
- Dim pr As Presentation
12
-
13
- Dim sl As Slide
14
-
15
- Dim sh As Shape
16
-
17
- Dim tb As Table
18
-
19
- Dim r As Integer
20
-
21
- Dim c As Integer
22
-
23
- Dim s As String
24
-
25
- Dim t As String
26
-
27
-
28
-
29
- Dim f1 As Boolean
30
-
31
- Dim f2 As Boolean
32
-
33
- Dim ol As Object
34
-
35
- Dim mail As Object
36
-
37
- Dim f As Object
38
-
39
- Dim dic As Object
40
-
41
- Dim k As Variant
42
-
43
- Dim n As Variant
44
-
45
- Dim mailTo As String
46
-
47
-
48
-
49
- With Application.FileDialog(msoFileDialogOpen)
50
-
51
- .Filters.Clear
52
-
53
- .Filters.Add "ppt", "*.ppt?"
54
-
55
- .InitialFileName = "C:\"
56
-
57
- .AllowMultiSelect = False
58
-
59
- If Not .Show Then Exit Sub
60
-
61
- file = .SelectedItems(1)
62
-
63
- End With
64
-
65
-
66
-
67
- Do
68
-
69
- Set pr = Presentations.Open(file)
70
-
71
- For Each sl In pr.Slides
72
-
73
- f1 = False
74
-
75
- f2 = False
76
-
77
- For Each sh In sl.Shapes
78
-
79
- If sh.HasTable Then
80
-
81
- Set tb = sh.Table
82
-
83
- For r = 1 To tb.Rows.Count
84
-
85
- For c = 1 To tb.Rows(r).Cells.Count
86
-
87
- s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
88
-
89
- t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
90
-
91
- '宛先
92
-
93
- If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
94
-
95
- f1 = True
96
-
97
- mailTo = "syunsuke"
98
-
99
- End If
100
-
101
- If InStr(s, "フレッツ") Then
102
-
103
- f1 = True
104
-
105
- mailTo = "b230420"
106
-
107
- End If
108
-
109
- If InStr(s, "INS") Then
110
-
111
- f1 = True
112
-
113
- mailTo = "b230420"
114
-
115
- End If
116
-
117
-
118
-
119
- If InStr(s, "秋田") And r < tb.Rows.Count Then
120
-
121
- If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
122
-
123
- End If
124
-
125
- If f1 And f2 Then Exit Do
126
-
127
- Next
128
-
129
- Next
130
-
131
- End If
132
-
133
- Next
134
-
135
- Next
136
-
137
- MsgBox "無かった"
138
-
139
- Loop Until True
140
-
141
- pr.Close
142
-
143
-
144
-
145
- If Not (f1 And f2) Then Exit Sub
146
-
147
- '
148
-
149
- MsgBox "見つけた"
150
-
151
-
152
-
153
-
154
-
155
- Set ol = CreateObject("Outlook.Application")
156
-
157
- Set mail = ol.CreateItem(olMailItem)
158
-
159
- mail.Display
160
-
161
-
162
-
163
- mail.To = mailTo '宛先
164
-
165
- mail.Subject = "件名"
166
-
167
- mail.Body = "本文"
168
-
169
-
170
-
171
- '添付ファイル
172
-
173
- mail.Attachments.Add file
174
-
175
-
176
-
177
- '添付ファイル
178
-
179
- With Application.FileDialog(msoFileDialogOpen)
180
-
181
- .Filters.Clear
182
-
183
- .Filters.Add "添付ファイル", "*.*"
184
-
185
- .InitialFileName = "C:\"
186
-
187
- .AllowMultiSelect = True
188
-
189
- If .Show Then
190
-
191
- Dim o As Integer
192
-
193
- For o = 1 To .SelectedItems.Count
194
-
195
- mail.Attachments.Add .SelectedItems(o)
196
-
197
- Next
198
-
199
- End If
200
-
201
- End With
202
-
203
-
204
-
205
- 'メール送信
206
-
207
- mail.Send '送信
208
-
209
-
210
-
211
- ol.Quit
3
+ コード
4
+
5
+ Sub 最終sample()
6
+
7
+ Const olMailItem = 0
8
+
9
+ Dim file As String
10
+
11
+ Dim pr As Presentation
12
+
13
+ Dim sl As Slide
14
+
15
+ Dim sh As Shape
16
+
17
+ Dim tb As Table
18
+
19
+ Dim r As Integer
20
+
21
+ Dim c As Integer
22
+
23
+ Dim s As String
24
+
25
+ Dim t As String
26
+
27
+
28
+
29
+ Dim f1 As Boolean
30
+
31
+ Dim f2 As Boolean
32
+
33
+ Dim ol As Object
34
+
35
+ Dim mail As Object
36
+
37
+ Dim f As Object
38
+
39
+ Dim dic As Object
40
+
41
+ Dim k As Variant
42
+
43
+ Dim n As Variant
44
+
45
+ Dim mailTo As String
46
+
47
+
48
+
49
+ With Application.FileDialog(msoFileDialogOpen)
50
+
51
+ .Filters.Clear
52
+
53
+ .Filters.Add "ppt", "*.ppt?"
54
+
55
+ .InitialFileName = "C:\"
56
+
57
+ .AllowMultiSelect = False
58
+
59
+ If Not .Show Then Exit Sub
60
+
61
+ file = .SelectedItems(1)
62
+
63
+ End With
64
+
65
+
66
+
67
+ Do
68
+
69
+ Set pr = Presentations.Open(file)
70
+
71
+ For Each sl In pr.Slides
72
+
73
+ f1 = False
74
+
75
+ f2 = False
76
+
77
+ For Each sh In sl.Shapes
78
+
79
+ If sh.HasTable Then
80
+
81
+ Set tb = sh.Table
82
+
83
+ For r = 1 To tb.Rows.Count
84
+
85
+ For c = 1 To tb.Rows(r).Cells.Count
86
+
87
+ s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
88
+
89
+ t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
90
+
91
+ '宛先
92
+
93
+ If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
94
+
95
+ f1 = True
96
+
97
+ mailTo = "syunsuke"
98
+
99
+ End If
100
+
101
+ If InStr(s, "フレッツ") Then
102
+
103
+ f1 = True
104
+
105
+ mailTo = "b230420"
106
+
107
+ End If
108
+
109
+ If InStr(s, "INS") Then
110
+
111
+ f1 = True
112
+
113
+ mailTo = "b230420"
114
+
115
+ End If
116
+
117
+
118
+
119
+ If InStr(s, "秋田") And r < tb.Rows.Count Then
120
+
121
+ If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
122
+
123
+ End If
124
+
125
+ If f1 And f2 Then Exit Do
126
+
127
+ Next
128
+
129
+ Next
130
+
131
+ End If
132
+
133
+ Next
134
+
135
+ Next
136
+
137
+ MsgBox "無かった"
138
+
139
+ Loop Until True
140
+
141
+ pr.Close
142
+
143
+
144
+
145
+ If Not (f1 And f2) Then Exit Sub
146
+
147
+ '
148
+
149
+ MsgBox "見つけた"
150
+
151
+
152
+
153
+ Set ol = CreateObject("Outlook.Application")
154
+
155
+ Set mail = ol.CreateItem(olMailItem)
156
+
157
+ mail.Display
158
+
159
+
160
+
161
+ mail.To = mailTo '宛先
162
+
163
+ mail.Subject = "件名"
164
+
165
+ mail.Body = "本文"
166
+
167
+
168
+
169
+ '添付ファイル
170
+
171
+ mail.Attachments.Add file
172
+
173
+
174
+
175
+ '添付ファイル
176
+
177
+ With Application.FileDialog(msoFileDialogOpen)
178
+
179
+ .Filters.Clear
180
+
181
+ .Filters.Add "添付ファイル", "*.*"
182
+
183
+ .InitialFileName = "C:\"
184
+
185
+ .AllowMultiSelect = True
186
+
187
+ If .Show Then
188
+
189
+ Dim o As Integer
190
+
191
+ For o = 1 To .SelectedItems.Count
192
+
193
+ mail.Attachments.Add .SelectedItems(o)
194
+
195
+ Next
196
+
197
+ End If
198
+
199
+ End With
200
+
201
+
202
+
203
+ 'メール送信
204
+
205
+ mail.Send '送信
206
+
207
+
208
+
209
+ ol.Quit
212
210
 
213
211
 
214
212
 
@@ -217,3 +215,7 @@
217
215
 
218
216
 
219
217
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
218
+
219
+
220
+
221
+ ```

4

2021/10/31 02:17

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -96,8 +96,6 @@
96
96
 
97
97
  mailTo = "syunsuke"
98
98
 
99
- mailTo = "aquarius0319"
100
-
101
99
  End If
102
100
 
103
101
  If InStr(s, "フレッツ") Then

3

2021/10/31 01:18

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -2,9 +2,7 @@
2
2
 
3
3
 
4
4
 
5
- コード
6
-
7
- ```Sub 最終sample()
5
+ コード```Sub 最終sample()
8
6
 
9
7
  Const olMailItem = 0
10
8
 

2

2021/10/31 01:16

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -1,221 +1,223 @@
1
+ ```VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
+
3
+
4
+
5
+ コード
6
+
7
+ ```Sub 最終sample()
8
+
9
+ Const olMailItem = 0
10
+
11
+ Dim file As String
12
+
13
+ Dim pr As Presentation
14
+
15
+ Dim sl As Slide
16
+
17
+ Dim sh As Shape
18
+
19
+ Dim tb As Table
20
+
21
+ Dim r As Integer
22
+
23
+ Dim c As Integer
24
+
25
+ Dim s As String
26
+
27
+ Dim t As String
28
+
29
+
30
+
31
+ Dim f1 As Boolean
32
+
33
+ Dim f2 As Boolean
34
+
35
+ Dim ol As Object
36
+
37
+ Dim mail As Object
38
+
39
+ Dim f As Object
40
+
41
+ Dim dic As Object
42
+
43
+ Dim k As Variant
44
+
45
+ Dim n As Variant
46
+
47
+ Dim mailTo As String
48
+
49
+
50
+
51
+ With Application.FileDialog(msoFileDialogOpen)
52
+
53
+ .Filters.Clear
54
+
55
+ .Filters.Add "ppt", "*.ppt?"
56
+
57
+ .InitialFileName = "C:\"
58
+
59
+ .AllowMultiSelect = False
60
+
61
+ If Not .Show Then Exit Sub
62
+
63
+ file = .SelectedItems(1)
64
+
65
+ End With
66
+
67
+
68
+
69
+ Do
70
+
71
+ Set pr = Presentations.Open(file)
72
+
73
+ For Each sl In pr.Slides
74
+
75
+ f1 = False
76
+
77
+ f2 = False
78
+
79
+ For Each sh In sl.Shapes
80
+
81
+ If sh.HasTable Then
82
+
83
+ Set tb = sh.Table
84
+
85
+ For r = 1 To tb.Rows.Count
86
+
87
+ For c = 1 To tb.Rows(r).Cells.Count
88
+
89
+ s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
90
+
91
+ t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
92
+
93
+ '宛先
94
+
95
+ If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
96
+
97
+ f1 = True
98
+
99
+ mailTo = "syunsuke"
100
+
101
+ mailTo = "aquarius0319"
102
+
103
+ End If
104
+
105
+ If InStr(s, "フレッツ") Then
106
+
107
+ f1 = True
108
+
109
+ mailTo = "b230420"
110
+
111
+ End If
112
+
113
+ If InStr(s, "INS") Then
114
+
115
+ f1 = True
116
+
117
+ mailTo = "b230420"
118
+
119
+ End If
120
+
121
+
122
+
123
+ If InStr(s, "秋田") And r < tb.Rows.Count Then
124
+
125
+ If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
126
+
127
+ End If
128
+
129
+ If f1 And f2 Then Exit Do
130
+
131
+ Next
132
+
133
+ Next
134
+
135
+ End If
136
+
137
+ Next
138
+
139
+ Next
140
+
141
+ MsgBox "無かった"
142
+
143
+ Loop Until True
144
+
145
+ pr.Close
146
+
147
+
148
+
149
+ If Not (f1 And f2) Then Exit Sub
150
+
151
+ '
152
+
153
+ MsgBox "見つけた"
154
+
155
+
156
+
157
+
158
+
159
+ Set ol = CreateObject("Outlook.Application")
160
+
161
+ Set mail = ol.CreateItem(olMailItem)
162
+
163
+ mail.Display
164
+
165
+
166
+
167
+ mail.To = mailTo '宛先
168
+
169
+ mail.Subject = "件名"
170
+
171
+ mail.Body = "本文"
172
+
173
+
174
+
175
+ '添付ファイル
176
+
177
+ mail.Attachments.Add file
178
+
179
+
180
+
181
+ '添付ファイル
182
+
183
+ With Application.FileDialog(msoFileDialogOpen)
184
+
185
+ .Filters.Clear
186
+
187
+ .Filters.Add "添付ファイル", "*.*"
188
+
189
+ .InitialFileName = "C:\"
190
+
191
+ .AllowMultiSelect = True
192
+
193
+ If .Show Then
194
+
195
+ Dim o As Integer
196
+
197
+ For o = 1 To .SelectedItems.Count
198
+
199
+ mail.Attachments.Add .SelectedItems(o)
200
+
201
+ Next
202
+
203
+ End If
204
+
205
+ End With
206
+
207
+
208
+
209
+ 'メール送信
210
+
211
+ mail.Send '送信
212
+
213
+
214
+
215
+ ol.Quit
216
+
217
+
218
+
219
+ End Sub
220
+
221
+
222
+
1
223
  VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？
2
-
3
-
4
-
5
- Sub 最終sample()
6
-
7
- Const olMailItem = 0
8
-
9
- Dim file As String
10
-
11
- Dim pr As Presentation
12
-
13
- Dim sl As Slide
14
-
15
- Dim sh As Shape
16
-
17
- Dim tb As Table
18
-
19
- Dim r As Integer
20
-
21
- Dim c As Integer
22
-
23
- Dim s As String
24
-
25
- Dim t As String
26
-
27
-
28
-
29
- Dim f1 As Boolean
30
-
31
- Dim f2 As Boolean
32
-
33
- Dim ol As Object
34
-
35
- Dim mail As Object
36
-
37
- Dim f As Object
38
-
39
- Dim dic As Object
40
-
41
- Dim k As Variant
42
-
43
- Dim n As Variant
44
-
45
- Dim mailTo As String
46
-
47
-
48
-
49
- With Application.FileDialog(msoFileDialogOpen)
50
-
51
- .Filters.Clear
52
-
53
- .Filters.Add "ppt", "*.ppt?"
54
-
55
- .InitialFileName = "C:\"
56
-
57
- .AllowMultiSelect = False
58
-
59
- If Not .Show Then Exit Sub
60
-
61
- file = .SelectedItems(1)
62
-
63
- End With
64
-
65
-
66
-
67
- Do
68
-
69
- Set pr = Presentations.Open(file)
70
-
71
- For Each sl In pr.Slides
72
-
73
- f1 = False
74
-
75
- f2 = False
76
-
77
- For Each sh In sl.Shapes
78
-
79
- If sh.HasTable Then
80
-
81
- Set tb = sh.Table
82
-
83
- For r = 1 To tb.Rows.Count
84
-
85
- For c = 1 To tb.Rows(r).Cells.Count
86
-
87
- s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
88
-
89
- t = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
90
-
91
- '宛先
92
-
93
- If InStr(s, "専用") > 0 And InStr(t, "INS") > 0 Then
94
-
95
- f1 = True
96
-
97
- mailTo = "syunsuke"
98
-
99
- mailTo = "aquarius0319"
100
-
101
- End If
102
-
103
- If InStr(s, "フレッツ") Then
104
-
105
- f1 = True
106
-
107
- mailTo = "b230420"
108
-
109
- End If
110
-
111
- If InStr(s, "INS") Then
112
-
113
- f1 = True
114
-
115
- mailTo = "b230420"
116
-
117
- End If
118
-
119
-
120
-
121
- If InStr(s, "秋田") And r < tb.Rows.Count Then
122
-
123
- If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
124
-
125
- End If
126
-
127
- If f1 And f2 Then Exit Do
128
-
129
- Next
130
-
131
- Next
132
-
133
- End If
134
-
135
- Next
136
-
137
- Next
138
-
139
- MsgBox "無かった"
140
-
141
- Loop Until True
142
-
143
- pr.Close
144
-
145
-
146
-
147
- If Not (f1 And f2) Then Exit Sub
148
-
149
- '
150
-
151
- MsgBox "見つけた"
152
-
153
-
154
-
155
-
156
-
157
- Set ol = CreateObject("Outlook.Application")
158
-
159
- Set mail = ol.CreateItem(olMailItem)
160
-
161
- mail.Display
162
-
163
-
164
-
165
- mail.To = mailTo '宛先
166
-
167
- mail.Subject = "件名"
168
-
169
- mail.Body = "本文"
170
-
171
-
172
-
173
- '添付ファイル
174
-
175
- mail.Attachments.Add file
176
-
177
-
178
-
179
- '添付ファイル
180
-
181
- With Application.FileDialog(msoFileDialogOpen)
182
-
183
- .Filters.Clear
184
-
185
- .Filters.Add "添付ファイル", "*.*"
186
-
187
- .InitialFileName = "C:\"
188
-
189
- .AllowMultiSelect = True
190
-
191
- If .Show Then
192
-
193
- Dim o As Integer
194
-
195
- For o = 1 To .SelectedItems.Count
196
-
197
- mail.Attachments.Add .SelectedItems(o)
198
-
199
- Next
200
-
201
- End If
202
-
203
- End With
204
-
205
-
206
-
207
- 'メール送信
208
-
209
- mail.Send '送信
210
-
211
-
212
-
213
- ol.Quit
214
-
215
-
216
-
217
- End Sub
218
-
219
-
220
-
221
- VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？

1

文書の変更

2021/10/31 01:16

投稿

shunsuke_0319
shunsuke_0319

スコア2

test CHANGED
File without changes
test CHANGED
@@ -215,3 +215,7 @@
215
215
 
216
216
 
217
217
  End Sub
218
+
219
+
220
+
221
+ VBAで専用かつINSの時にメールをsyunsukeに送りたいのですがこれだとaquarius0319にしか行きません なぜでしょうか？