質問編集履歴

3

作成中のコード全文をコピペ、新たなエラー表示に更新しました。見にくかったらすみません。

2020/09/18 02:06

投稿

ajiko
ajiko

スコア0

test CHANGED
File without changes
test CHANGED
@@ -152,11 +152,13 @@
152
152
 
153
153
 
154
154
 
155
+ デバッグ(F8で進んでいく)というものをした時に2周めの★印のところでエラーが表示されます。
155
156
 
157
+ 見に行くエクセルの方は1行目と同じフォルダの場所となっており、ファイル名が異なる状態です。
156
158
 
157
- 見よう見まねコピペで作ったでデバッグというをした時に★印ところでエラーが表示されます。
159
+ エクセル側問題なのかしれませんが、どこどう直したらいい
158
160
 
159
- さっぱり分駆らずお手上げです…もしお助けいただければとても助かります。
161
+ さっぱりわからずお手上げです…お助けいただければとても助かります。
160
162
 
161
163
  よろしくお願いします。
162
164
 

2

作成中のコード全文をコピペしました。見にくかったらすみません。

2020/09/18 02:06

投稿

ajiko
ajiko

スコア0

test CHANGED
File without changes
test CHANGED
@@ -26,9 +26,9 @@
26
26
 
27
27
  エラーメッセージ
28
28
 
29
- 実行時エラー'-2147417851(80010105)':
29
+ 実行時エラー'-2147024894(80070002)':
30
30
 
31
- 'To'メソッドは失敗しました:'_MailItem'オブジェクト
31
+ ファイルが見つかりせん。パスとファイル名が正いかどうかを確認してください。
32
32
 
33
33
  ```
34
34
 
@@ -36,25 +36,9 @@
36
36
 
37
37
  ### 該当のソースコード
38
38
 
39
+ ```ここに言語を入力
39
40
 
40
-
41
-
42
-
43
- 見よう見まねコピペで作ったのでデバッグというものをした時に★印のところでエラーが表示されます。
44
-
45
- さっぱり分駆らずお手上げです…もしお助けいただければとても助かります。
46
-
47
- よろしくお願いします。
48
-
49
-
50
-
51
-
52
-
53
- ```ここに言語名を入力
54
-
55
-
56
-
57
- Sub Outlook()
41
+ Sub Outlook()
58
42
 
59
43
 
60
44
 
@@ -142,10 +126,6 @@
142
126
 
143
127
 
144
128
 
145
-
146
-
147
-
148
-
149
129
  End If
150
130
 
151
131
 
@@ -168,6 +148,28 @@
168
148
 
169
149
 
170
150
 
151
+ ```
152
+
153
+
154
+
155
+
156
+
157
+ 見よう見まねコピペで作ったのでデバッグというものをした時に★印のところでエラーが表示されます。
158
+
159
+ さっぱり分駆らずお手上げです…もしお助けいただければとても助かります。
160
+
161
+ よろしくお願いします。
162
+
163
+
164
+
165
+
166
+
167
+ ```ここに言語名を入力
168
+
169
+
170
+
171
+
172
+
171
173
 
172
174
 
173
175
  ### 試したこと

1

作成中のコード全文をコピペしました。見にくかったらすみません。

2020/09/18 02:02

投稿

ajiko
ajiko

スコア0

test CHANGED
File without changes
test CHANGED
@@ -54,7 +54,47 @@
54
54
 
55
55
 
56
56
 
57
+ Sub Outlook()
58
+
59
+
60
+
61
+ Dim oApp
62
+
63
+ Dim Wm_ITEM
64
+
65
+ Dim Wm_TO
66
+
67
+ Set oApp = CreateObject("Outlook.Application")
68
+
69
+ Set myNameSpace = oApp.GetNamespace("MAPI")
70
+
71
+ Set myFolder = myNameSpace.GetDefaultFolder(6)
72
+
73
+ myFolder.display
74
+
75
+
76
+
77
+ Dim folder As String
78
+
79
+ Dim FileAd As String
80
+
81
+ Dim row As Long
82
+
83
+ Dim shname As String
84
+
85
+
86
+
87
+ row = 2
88
+
89
+ shname = "sheet1"
90
+
91
+
92
+
93
+ Do Until row = 5
94
+
95
+
96
+
57
- Set Wm_ITEM = oApp.CreateItem(0)
97
+ Set Wm_ITEM = oApp.CreateItem(0)
58
98
 
59
99
  Wm_TO = ""
60
100
 
@@ -64,25 +104,69 @@
64
104
 
65
105
  If ThisWorkbook.Sheets(shname).Cells(row, 1) <> "" Then
66
106
 
67
-
107
+
68
108
 
69
- Wm_ITEM.To = ThisWorkbook.Sheets(shname).Cells(row, 5)★
109
+
70
110
 
71
- Wm_ITEM.CC = ThisWorkbook.Sheets(shname).Cells(row, 6)
111
+ Wm_ITEM.To = ThisWorkbook.Sheets(shname).Cells(row, 5).Value
72
112
 
73
- Wm_ITEM.Subject = ThisWorkbook.Sheets(shname).Cells(row, 7)
113
+ Wm_ITEM.CC = ThisWorkbook.Sheets(shname).Cells(row, 6).Value
74
114
 
75
- Wm_ITEM.Body = ThisWorkbook.Sheets(shname).Cells(row, 3) & _
115
+ Wm_ITEM.Subject = ThisWorkbook.Sheets(shname).Cells(row, 7).Value
76
116
 
117
+ Wm_ITEM.Body = ThisWorkbook.Sheets(shname).Cells(row, 2) & _
118
+
77
- ThisWorkbook.Sheets(shname).Cells(row, 4)
119
+ ThisWorkbook.Sheets(shname).Cells(row, 4).Value
78
120
 
79
121
  Wm_ITEM.Body = Wm_ITEM.Body _
80
122
 
81
123
  & vbCrLf _
82
124
 
83
- & ThisWorkbook.Sheets(shname).Cells(row, 8)
125
+ & ThisWorkbook.Sheets(shname).Cells(row, 8).Value
84
126
 
127
+
128
+
129
+ folder = ThisWorkbook.Sheets(shname).Cells(row, 9).Value
130
+
131
+ FileAd = ThisWorkbook.Sheets(shname).Cells(row, 10).Value
132
+
133
+
134
+
135
+ Wm_ITEM.Attachments.Add folder & "\" & FileAd ★
136
+
137
+ Wm_ITEM.display
138
+
139
+
140
+
141
+ Wm_ITEM.Save
142
+
143
+
144
+
145
+
146
+
147
+
148
+
149
+ End If
150
+
151
+
152
+
153
+ row = row + 1
154
+
155
+
156
+
85
- ```
157
+ Loop
158
+
159
+
160
+
161
+ MsgBox "OK"
162
+
163
+
164
+
165
+
166
+
167
+ End Sub
168
+
169
+
86
170
 
87
171
 
88
172