質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
SMTP

SMTP(Simple Mail Transfer Protocol)はIPネットワークでemailを伝送する為のプロトコルです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

5回答

15906閲覧

マクロでGmailを送りたい

teryyyyy2

総合スコア17

SMTP

SMTP(Simple Mail Transfer Protocol)はIPネットワークでemailを伝送する為のプロトコルです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

1クリップ

投稿2016/06/27 02:19

###前提・実現したいこと
マクロでGmailを使ってメールを送りたいのですがうまくいきません。

###発生している問題・エラーメッセージ

実行時エラー'2147220973(80040213)':
転送においてサーバーに接続出来ませんでした。
と出ます。

Option Explicit '----- 参照設定 Microsoft CDO for Windows 2XXX Library Public myCDOMsg As New CDO.Message Public Const myADDRESS As String _ = "http://schemas.microsoft.com/cdo/configuration/" Dim gyo As Long Dim gyo2 As Long Dim filecount As Long Dim sheetcount As Long Dim unmatch As Long Dim erfilecount As Long 'ボタンを押したとき Sub FolderSelect() 'ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents 'ThisWorkbook.Worksheets(2).Range("B1:BE3005").ClearContents Dim folderpass As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then folderpass = .SelectedItems(1) Else ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。" Exit Sub End If End With filecount = 0 sheetcount = 0 unmatch = 0 erfilecount = 0 gyo = 6 gyo2 = 2 ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中" Call FileSearch(folderpass, "*.csv") Dim dateupdate As String dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新" 'ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate 'ThisWorkbook.Worksheets(2).Name = dateupdate ' ThisWorkbook.Worksheets(1).Range("B2").Value = "完了" ThisWorkbook.Worksheets(2).Activate End Sub 'ファイル検索 Sub FileSearch(Path As String, Target As String) Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call FileSearch(Folder.Path, Target) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name Like Target Then filecount = filecount + 1 ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path Call ParCopy(File.Path) gyo = gyo + 1 End If ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。" Next File End Sub ''一覧出力 Sub ParCopy(Path As String) Dim openbook As Workbook Dim openbooksheet As Worksheet Dim lp As Long Dim el As Long Dim br As String 'オ Dim c As Range, Target As Range Dim LastRow As Long '縦軸(マクロ側シート数用) lp = 2 '横軸(データ側ループ管理用) el = 3 Application.ScreenUpdating = False On Error GoTo myError Set openbook = Application.Workbooks.Open(Path) 'シートを格納 Set openbooksheet = openbook.Worksheets(1) openbooksheet.Unprotect 'シート数でのループ Do Until lp = 28 '各シート毎のループ Do Until ThisWorkbook.Worksheets(lp).Cells(1, el) = "" br = ThisWorkbook.Worksheets(lp).Cells(2, el) 'オートフィルタ用のアクティブ化 openbooksheet.Activate Selection.AutoFilter openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br '最終行の指定 LastRow = 291826 'マクロ側へのコピペ openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el)) openbooksheet.Range("A1").AutoFilter el = el + 1 Loop 'シート側変数の初期化 el = 3 lp = lp + 1 Loop openbook.Close False Application.ScreenUpdating = True Call test02 Exit Sub myError: MsgBox Err.Description ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生" erfilecount = erfilecount + 1 Application.ScreenUpdating = True End Sub 'シート毎保存部分 Sub test02() Dim wb1 As Workbook Dim i As Long Dim s As Long Dim mo As String Set wb1 = ActiveWorkbook s = wb1.Sheets.Count s = s - 1 For i = 2 To s mo = ThisWorkbook.Worksheets(28).Cells(i, 2) Workbooks.Add.SaveAs Filename:="C:\Users\hogehoge\Desktop\集計\" & mo & ".xls" wb1.Worksheets(i).Copy before:=Workbooks(mo & ".xls").Worksheets(1) Workbooks(mo & ".xls").Worksheets(1).Name = mo Next i Call SendMail End Sub Sub SendMail() With myCDOMsg .To = "受信者 <hogehoge@docomo.ne.jp>" '----- 宛先 '表示名を設定しない場合は<>の中だけでよい。 '.To = "aaa@aaa.com;bbb@bbb.com" ' .CC = "ccc@ccc.com" '----- CC .From = "送信者 <test@gmail.com>" '----- 送信者 .Subject = "テストの件" '----- 件名 .TextBody = _ " テストです。" & vbCrLf & _ " テストです。" & vbCrLf & _ " テストです。" & vbCrLf & _ " テストです。" '----- 本文 With .Configuration.Fields .Item(myADDRESS & "sendusing") = 2 '----- SMTPサーバーを設定 .Item(myADDRESS & "smtpserver") = "smtp.gmail.com" .Item(myADDRESS & "smtpserverport") = 587 .Item(myADDRESS & "smtpauthenticate") = 1 .Item(myADDRESS & "smtpusessl") = True .Item(myADDRESS & "sendusername") = "ID" .Item(myADDRESS & "sendpassword") = "パスワード" .Update End With .Send End With End Sub

###試したこと
ポートを変えたり、ブラウザ側でセキュリティレベルを下げたりしてみたのですがうまくいきませんでした。

###補足情報(言語/FW/ツール等のバージョンなど)
WIN10/Excel2013でやっています
皆様のお力をお貸しください。
よろしくお願いします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答5

0

自己解決

何が原因なのかは結局わからず、別クライアントのメールを使うことにしました。
本来であれば検証するべきなのでしょうが、時間がないので代案で行くことにしました。
皆さまが引用していただいたサイトも繰り返し試してはみたものの原因解明とはいきませんでした。
力不足です。
検証できた際にはこちらで報告させていただきます。

投稿2016/06/28 01:28

teryyyyy2

総合スコア17

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

通信状況をエラーで吐かせるのが本来だと思いますが、出来ますか?

出来なければ、どのポート、どの設定なら接続できるのか、クライアントアプリから接続して確認してみては?
Outlook、Apple Mail などのメール クライアントに Gmail を設定する

設定に間違いがないとなれば、次に進むことが出来ます。

投稿2016/06/27 02:54

退会済みユーザー

退会済みユーザー

総合スコア0

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

環境がなく試してないのですが、下記のページによるとSSLの場合のポートは465になっていますね。
http://www.iodata.jp/support/qanda/answer/s18443.htm

投稿2016/06/27 02:42

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ちょっと情報が古いけど CDOを使ってGmail送信を行うVBAマクロ というページに
Google アカウントでログインした状態で「安全性の低いアプリを許可」ページを開き、
「有効にする」にチェックを入れます。 という記述があります。これは、確認済みですか?

見てみたところ画面は違いますが、同じ設定があるようです。

投稿2016/06/27 02:37

Mr_Roboto

総合スコア2208

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

teryyyyy2

2016/06/27 02:39

すでにやってあります…
Mr_Roboto

2016/06/27 02:40

なるほど、「試したこと」 として書いてもらえると助かります ^^
guest

0

GmailのAPIを使用するサンプルがありました。
http://www.ka-net.org/blog/?p=4524

投稿2016/06/27 02:26

tomo.ina

総合スコア357

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問