VBA | 文系出身のSEですが、何か

■Accessマクロ

GoogleSpreadSheetから自動でメール送信 GoogleSpreadSheetを使って指定時刻にメールを送信するプログラムを作ってみました。 GoogleSpread...

The post VBA Access エクセル出力色付け罫線 first appeared on 文系出身のSEですが、何か.

Excel VBA メール送信ツール(フリーメール)

LooseCarrot — Sat, 01 Dec 2018 15:01:53 +0000

VBAでメール送信について紹介します。

自動でメール送信するツールを作ってみました。

今回はOutlookではなくフリーメール(YahooJapan)です。

実際に作ったファイルはこちらから無料でダウンロードできます。

使い方の説明はこちらからダウンロード可能です。

エクセルの名前の定義

エクセル自体にもセル名の定義をしているので、まずそこから説明しておきます。

意外とエクセルのVBAでは名前の定義を色々使えると良いことが多いです。

仕様と合わせて説明します。

仕様

①「送信元アカウント」を選択します。

リストは「アカウント」をもとに選べます。

下の画像で言うと、Gmail、Yahoo、YahooUSAがあるので3つから選べる状態です。

②送信ボタンをクリックすると「送信元アドレス」からとなりのシートを１つずつ読込んでメールを送信していきます。

名前の定義

メインシートの各名前は以下のようなルールで定義づけしています。

SMTPServer　　　：[送信元アカウント] + [_smtpserver]
PortNumber　　　：[送信元アカウント] + [_smtpserverport]
送信アカウント名　：[送信元アカウント] + [_sendusername]
パスワード　　　　：[送信元アカウント] + [_sendpassword]
送信元アドレス　　：[送信元アカウント] + [_From]

「メール送信」ボタンクリック後、後続の処理で「送信元アカウント」と文字連結をして送信を行います。

メール用の参照設定(CDO)

参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft CDO for Windows 2000 Libraryにチェックを付けておいてください。

CDOとはMicrosoft Collaboration Data Objectsのことだそうです。

CDO は、メッセージング機能を持つアプリケーションの作成を容易にするために、あるいは、既存のアプリケーションにメッセージング機能を追加するために設計されたものです。
microsoft.comより

Gmailの送信許可は不可になった

~~Gmailアカウントを使ってメール送信する場合は「安全性の低いアプリのアクセス」許可しておく必要があります。~~

~~設定は以下にアクセスすることで変更できます。~~

https://myaccount.google.com/lesssecureapps

2022年5月からGmailはユーザとパスワードでログインすることはできなくなりました。

YahooJapanアカウントを使ってメール送信する場合は特に設定は必要はないようです。

メール送信処理のコード

処理の流れは以下の順です。

①メインシートから送信元情報を取得
②となりのシートから送信メール内容を取得
③添付ファイルをメールオブジェクトに貼り付ける
④メールを送信する
⑤次のシートを同様に処理

コード

'==============================
'目的　　　 ：シート分のメールを送信する
'==============================
Sub SendMail_Click()

　　Dim MyDir As String　　　　　　　　　　　　　　　　　　　'自分のファイルが存在するディレクトリ格納用
　　Dim i As Long　　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim j As Long　　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim SheetCnt As Long　　　　　　　　　　　　　　　　　　　'シート数を格納する変数
　　Dim SheetName As String　　　　　　　　　　　　　　　　　'シート名を格納する変数

　　Dim ToAddress As String　　　　　　　　　　　　　　　　　'Toアドレス用の変数
　　Dim CcAddress As String　　　　　　　　　　　　　　　　　'Ccアドレス用の変数
　　Dim BccAddress As String　　　　　　　　　　　　　　　　'Bccアドレス用の変数
　　Dim FromAddress As String　　　　　　　　　　　　　　　　'Fromアドレス用の変数
　　Dim cdoMsg As Object　　　　　　　　　　　　　　　　　　'CDOメッセージオブジェクト用変数
　　Dim cdoConf As Object　　　　　　　　　　　　　　　　　'CDOコンフィグレーションオブジェクト用変数
　　Dim strMailBody As String　　　　　　　　　　　　　　　'メール本文用の変数
　　Dim strSubject As String　　　　　　　　　　　　　　　　'件名用の変数
　　Dim strSignature As String　　　　　　　　　　　　　　　'署名用の変数
　　Dim strAttachmentPath As String　　　　　　　　　　　　'添付ファイルの格納用変数
　　Dim strAttachmentsPath() As String　　　　　　　　　　'添付ファイルの格納配列
　　Dim strSendAccount As String　　　　　　　　　　　　　　'送信するアカウント
　　
　　'固定値をセット(長いと見づらいため)
　　Const cstUnderscore As String = "_"　　　　　　　　　 'アンダーバー
　　Const cstSendusing As String = "http://schemas.microsoft.com/cdo/configuration/sendusing"
　　Const cstSmtpserver As String = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
　　Const cstSmtpserverport As String = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
　　Const cstSendusername As String = "http://schemas.microsoft.com/cdo/configuration/sendusername"
　　Const cstSendpassword As String = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
　　Const cstSmtpauthenticate As String = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
　　Const cstSmtpusessl As String = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

　　'エラー時はErrCatchラベルへ
　　On Error GoTo ErrCatch
　　
　　'-------シート枚数分ループ(2枚目のシートから)-------
　　'自分の配置されているパスを取得
　　MyDir = ThisWorkbook.Path
　　
　　'シート件数を取得
　　SheetCnt = ThisWorkbook.Sheets.Count
　　
　　For i = 2 To SheetCnt
　　
　　　　'----------送信元アカウント情報を設定(メインシートから取得)----------
　　　　'CDOをオブジェクト作成
　　　　Set cdoMsg = CreateObject("CDO.Message")
　　　　Set cdoConf = CreateObject("CDO.Configuration")
　　　　
　　　　cdoConf.Load -1
　　　　
　　　　'送信元アカウントを取得
　　　　strSendAccount = Sheets(1).Range("SendAccount").Value
　　　　
　　　　'送信元アカウントが未選択の場合終了
　　　　If strSendAccount = "" Then
　　　　　　MsgBox "送信元アカウントを設定してください。"
　　　　　　End
　　　　End If
　　　　
　　　　'送信元アカウントにアンダーバーをセット
　　　　strSendAccount = strSendAccount + cstUnderscore
　　　　
　　　　With cdoConf.Fields
　　　　　　.Item(cstSendusing) = 2
　　　　　　.Item(cstSmtpserver) = Sheets(1).Range(strSendAccount & "smtpserver").Value
　　　　　　.Item(cstSmtpserverport) = Sheets(1).Range(strSendAccount & "smtpserverport").Value
　　　　　　.Item(cstSendusername) = Sheets(1).Range(strSendAccount & "sendusername").Value
　　　　　　.Item(cstSendpassword) = Sheets(1).Range(strSendAccount & "sendpassword").Value
　　　　　　.Item(cstSmtpauthenticate) = True
　　　　　　.Item(cstSmtpusessl) = True
　　　　　　.Update
　　　　End With
　　　　
　　　　'Fromアドレス取得
　　　　FromAddress = Sheets(1).Range(strSendAccount & "From").Value
　　　　
　　　　'重要度を変更
　　　　cdoMsg.Fields.Item("urn:schemas:mailheader:X-Priority") = 1
　　　　cdoMsg.Fields.Update
　　　　
　　　　'-------各メールフォーマットから取得-------
　　　　'シート名を取得
　　　　SheetName = Sheets(i).Name

　　　　'-------メール情報を取得-------
　　　　'セル内改行(LF)はCRLFに置換 → Yahooでは落ちるため
　　　　ToAddress = Replace(Sheets(i).Range("Mail_TO").Value, vbLf, vbCrLf)　　　　　　'To宛先
　　　　CcAddress = Replace(Sheets(i).Range("Mail_CC").Value, vbLf, vbCrLf)　　　　　　'cc宛先
　　　　BccAddress = Replace(Sheets(i).Range("Mail_BCC").Value, vbLf, vbCrLf)　　　　　'bcc宛先
　　　　strSubject = Replace("【" & SheetName & "様】" & _
　　　　　　　　　　　　　　Sheets(i).Range("Mail_Subject").Value, vbLf, vbCrLf)　　　　'件名
　　　　strMailBody = Replace(Sheets(i).Range("Mail_Body").Value, vbLf, vbCrLf)　　　　'メール本文
　　　　strSignature = Replace(Sheets(i).Range("Mail_Signature").Value, vbLf, vbCrLf)　'署名
　　
　　　　'-------メールに情報をセットする-------
　　　　With cdoMsg
　　　　　　Set .Configuration = cdoConf
　　　　　　.From = FromAddress
　　　　　　.To = ToAddress
　　　　　　.CC = CcAddress
　　　　　　.BCC = BccAddress
　　　　　　.MDNRequested = True
　　　　　　.Subject = strSubject
　　　　　　.TextBody = strMailBody & vbCrLf & vbCrLf & strSignature
　　　　　　.BodyPart.Charset = "utf-8"
　　　　End With
　　　　
　　　　'-------添付ファイルを貼り付ける-------
　　　　'[yyyymmdd_会社名].[拡張子]を検索し、取得する
　　　　strAttachmentsPath() = FileSearch(Format(Now(), "yyyymmdd") & "_" & SheetName & ".*", MyDir & "\添付ファイル\")  '"

        If strAttachmentsPath(0) = "dummy" Then
            '添付ファイルが一件もなければ、次のメール処理へ行く(発注連絡が不要なため)
            GoTo nextDO
        Else
            '添付ファイルが一件でもあれば添付
    
                'ファイル件数分ループして添付する
                For j = 0 To UBound(strAttachmentsPath())
                    'ファイルパスを取得
                    strAttachmentPath = strAttachmentsPath(j)
    
                    'ファイルを添付
                    cdoMsg.AddAttachment strAttachmentPath
                Next j
        End If

　　　　'-------メールを送信する-------
　　　　'メール送信
　　　　cdoMsg.Send

nextDO:
　　　　'-------Outlookを閉じる(オブジェクトを解放)---
　　　　Set cdoMsg = Nothing
　　　　Set cdoConf = Nothing

　　Next i
　　
　　MsgBox "送信が完了しました。"
　　
'エラーキャッチ
ErrCatch:
　　
　　' エラーの場合、エラーメッセージを表示する
　　Call ShowErrMsg
　　
End Sub

メール送信処理の解説

送信元アカウント情報を設定(メインシートから取得)

strSendAccount = Sheets(1).Range(“SendAccount”).Value

でメインシートの名前「SendAccount」からアカウント名を取得しています。

その後取得したアカウント名とSMTPServerやPortNumberの名前を文字連結して送信するための情報を取得しています。

送信元アカウントでGmailを選んだなら.Range(strSendAccount & “smtpserver”).Valueの中身はRange(“Gmail_smtpserverport)”.Value

Yahooを選んだならRange(“Yahoo_smtpserverport”).Valueのようになります。

メール情報を取得

ここでは改行コードLFをCRLFに置換しています。

なぜかと言うとYahooで送信する場合は、エラーになるためです。

改行コードがCRとLFではなく、LFだけの行があるために、エラー
メールが送信できるようになった　より

改行があっても動いて欲しいものですが、仕様なら仕方ありませんね…

メールに情報をセットする

ここではメールのオブジェクトに件名や宛先などをセットしています。

添付ファイルを貼り付ける

FileSearchメソッドを使って、添付ファイルのパスを取得しメールのオブジェクトに張り付ける処理を行っています。

FileSearchは後で説明を記載しています。

その後、添付ファイルがない場合、メールは送らず次のシートを処理するようになっています。

※発注連絡という想定なので、発注書の添付ファイルがなければ連絡はする必要がないから送らないという考え方です。

メール添付ファイル取得 FileSearchメソッド

送信対象のファイル([yyyymmdd_シート名.拡張子]フォーマット)のファイル名を検索し配列に格納する処理です。

検索する場所は「..\VBA Outlookメール送信\添付ファイル」以下のみです。

他の場所に配置したファイルは添付ファイルとして検索されません。

コード

'==============================
'目的　　　 ：添付ファイルを検索し、ファイルのパスを取得する
'引数　　　 ：SearchText　　　　　　　　　検索するファイル名
'　　　　　　　：SearchPath　　　　　　　　 検索するパス
'戻り値　　　: ファイルパスの配列
'==============================
Private Function FileSearch(SearchText As String, SearchPath As String) As String()

    Dim FileName As String
    Dim Cnt As Long
    Dim Files() As String                         'ファイルパス格納用配列
    
    '中身をダミー値でセット
    ReDim Files(0)
    Files(0) = "dummy"
    
    'ファイルを検索
    FileName = Dir(SearchPath & "\" & SearchText)
    
    Do While FileName <> ""
        
        'ファイル名を返却用配列に格納
        ReDim Preserve Files(Cnt) As String
        Files(Cnt) = SearchPath & FileName
        Cnt = Cnt + 1
        
        ' 次のファイル名を参照
        FileName = Dir()
    Loop

    FileSearch = Files()
　　
End Function

解説

引数として受け取った検索フォルダ(SearchPath)を検索条件(SearchText)を元に検索します。

見つかったファイルのパスを配列に格納していきます。

検索条件に一致するファイルが見つからなくなったら配列を呼び出し元に返しています。

エラー表示 ShowErrMsgメソッド

エラーをキャッチするメソッドです。

予測できないエラーがあればここでキャッチしてエラーがあったことをメッセージ表示します。

コード

'==============================
'目的　　　 ：エラーの場合、エラーメッセージを表示する
'==============================
Public Sub ShowErrMsg()

　　'エラーがあればメッセージ表示
　　If Err.Number <> 0 Then
　　　　MsgBox "想定外のエラーが発生しました。" & vbCrLf + _
　　　　　　　　"エラー番号：" + CStr(Err.Number) & vbCrLf + _
　　　　　　　　"エラーの種類：" + Err.Description
　　End If

End Sub

解説

エラーがあった場合、そのエラー番号とエラー内容をメッセージ表示します。

送信結果

送信結果はこんなメールです。

GoogleSpreadSheetから自動で予定をメールお知らせ予定がいっぱいあると、忘れてしまいがちなので、事前に通知してくれるアプリが欲しいと思っていました。なので、以前C#で予定...

・メールを送信する
http://officetanaka.net/excel/vba/tips/tips45.htm
・「 Gmailで相手に一斉に送信するエクセルマクロ」のコメント一覧
http://bzowner.blog.fc2.com/blog-entry-2.html?sp&m2=res
・CDO.Messageによるメール送信
http://serialty.blog117.fc2.com/blog-entry-10.html
・iCloud メールクライアント向けのメールサーバ設定
https://support.apple.com/ja-jp/HT202304
・CDOでメール送信
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_080.html
・VBAでメール送信する
https://excel-ubara.com/excelvba4/EXCEL233.html
・VBAでGmail送信！CDOを活用してメールを操作する方法
http://www.fastclassinfo.com/entry/vba_gmail_sendmail
・メールが送信できるようになった
https://ajya.hatenablog.jp/entry/2012/03/22/223917
・CDO の概要
https://msdn.microsoft.com/ja-jp/library/cc446847.aspx

・【Excel VBA】【マクロ】【Tips】Sgn関数はExcel64bit版では使えない？

https://lenoco.tokyo/?p=136

The post Excel VBA メール送信ツール(フリーメール) first appeared on 文系出身のSEですが、何か.

Excel VBA メール送信ツール(Outlook)

LooseCarrot — Fri, 30 Nov 2018 15:01:29 +0000

VBAでOutlookのメール送信について紹介します。

自動でOutlookのメール送信するツールを作ってみました。

実際に作ったファイルはこちらから無料でダウンロードできます。

メール(Outlook)用の参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Outlook 16.0 Object Libraryにチェックを付けておいてください。

16.0はバージョンに寄ります。

メール(Outlook)送信処理のコード

処理の流れは以下の順です。

①メール情報(件名、宛先など)を取得
②メールに情報をセットする
③添付ファイルを貼り付ける
④メールを送信する
⑤次のエクセルシートの情報を読取って①から～④を繰り返す

コード

'==============================
'目的　　　 ：シート分のメールを送信する
'==============================
Sub SendMail_Click()
　　
　　Dim MyDir As String　　　　　　　　　　　　　　　　　'自分のファイルが存在するディレクトリ格納用
　　Dim i As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim j As Long　　　　　　　　　　　　　　　　　　　　　'ループ用変数
　　Dim SheetCnt As Long　　　　　　　　　　　　　　　　　'シート数を格納する変数
　　Dim SheetName As String　　　　　　　　　　　　　　　'シート名を格納する変数
　　
　　Dim ToAddress As String　　　　　　　　　　　　　　　'Toアドレス用の変数
　　Dim CcAddress As String　　　　　　　　　　　　　　　'Ccアドレス用の変数
　　Dim BccAddress As String　　　　　　　　　　　　　　'Bccアドレス用の変数
　　Dim Subject As String　　　　　　　　　　　　　　　　'件名用の変数
　　Dim MailBody As String　　　　　　　　　　　　　　　'メール本文用の変数
　　Dim Signature As String　　　　　　　　　　　　　　'署名用の変数
　　Dim OutlookObj As Outlook.Application　　　　　　'Outlookで使用するオブジェクト生成
　　Dim MailItemObj As Outlook.MailItem　　　　　　　'Outlookで使用するオブジェクト生成
　　Dim Attachments As Outlook.Attachments　　　　 'Outlookで使用するオブジェクト生成
　　Dim AttachmentPath As String　　　　　　　　　　　'添付ファイルの格納用変数
　　Dim AttachmentsPath() As String　　　　　　　　　'添付ファイルの格納配列
　　
　　
　　'自分の配置されているパスを取得
　　MyDir = ThisWorkbook.Path
　　
　　'シート件数を取得
　　SheetCnt = ThisWorkbook.Sheets.Count

　　'-------シート枚数分ループ(2枚目のシートから)-------
　　For i = 2 To SheetCnt
　　
　　　　'シート名を取得
　　　　SheetName = Sheets(i).Name

　　　　'-------メール情報を取得-------
　　　　ToAddress = Sheets(i).Range("Mail_TO").Value　　　　　　　　　'To宛先
　　　　CcAddress = Sheets(i).Range("Mail_CC").Value　　　　　　　　　'cc宛先
　　　　BccAddress = Sheets(i).Range("Mail_BCC").Value　　　　　　　　'bcc宛先
　　　　Subject = "【" & SheetName & "様】" & _
　　　　　　　　　　　　Sheets(i).Range("Mail_Subject").Value　　　　　'件名
　　　　MailBody = Sheets(i).Range("Mail_Body").Value　　　　　　　　'メール本文
　　　　Signature = Sheets(i).Range("Mail_Signature").Value　　　　 '署名
　　
　　　　'-------メールに情報をセットする-------
　　　　Set OutlookObj = CreateObject("Outlook.Application")
　　　　Set MailItemObj = OutlookObj.CreateItem(olMailItem)
　　　　MailItemObj.BodyFormat = 2　　　　　　　　　　　　　　　　　　　　　　　'HTML形式に変更
　　　　MailItemObj.To = ToAddress　　　　　　　　　　　　　　　　　　　　　　　'to宛先をセット
　　　　MailItemObj.CC = CcAddress　　　　　　　　　　　　　　　　　　　　　　　'cc宛先をセット
　　　　MailItemObj.BCC = BccAddress　　　　　　　　　　　　　　　　　　　　　　'bcc宛先をセット
　　　　MailItemObj.Subject = Subject　　　　　　　　　　　　　　　　　　　　　 '件名をセット
　　　　MailItemObj.Body = MailBody & vbCrLf & vbCrLf & Signature　　　 '本文+署名
　　　　
　　　　'-------添付ファイルを貼り付ける-------'
　　　　'オブジェクト生成
　　　　Set Attachments = MailItemObj.Attachments
　　　　
　　　　'[yyyymmdd_会社名].[拡張子]を検索し、取得する'
　　　　AttachmentsPath() = FileSearch(Format(Now(), "yyyymmdd") & "_" & SheetName & ".*", MyDir & "\添付ファイル\")　'"
　　　　

        If AttachmentsPath(0) = "dummy" Then
            '添付ファイルが一件もなければ、次のメール処理へ行く(発注連絡が不要なため)
            GoTo nextDO
        Else
            '添付ファイルが一件でもあれば添付
    
                'ファイル件数分ループして添付する
                For j = 0 To UBound(AttachmentsPath())
                    'ファイルパスを取得
                    AttachmentPath = AttachmentsPath(j)
    
                    'ファイルを添付
                    Attachments.Add AttachmentPath
    
                Next j
    
        End If
　　
　　　　'-------メールを送信する-------
　　　　MailItemObj.Send
　　
　　　　'-------Outlookを閉じる(オブジェクトを解放)---
　　　　Set OutlookObj = Nothing
　　　　Set MailItemObj = Nothing
　　　　
nextDO:
　　Next i
　　
　　MsgBox "送信が完了しました。"
　　
End Sub

解説

メール情報を取得

重要なポイントは名前の定義をしていることです。

宛先Toであれば「Mail_TO」のようにすべてのシートに設定がしてあります。

各シートに全て同じ名前を付けることで同じ処理をシートごとに繰り返せるようにしています。

そして各シートの値は変数に格納していく処理になっています。

※シートをコピーして増やしても名前の定義は引き継がれるため処理に問題はありません。

メールに情報をセットする

Outlookのオブジェクトを生成していま。

その後、それぞれToや本文の情報をOutlookのオブジェクトにセットしていっています。

添付ファイルを貼り付ける

まず添付ファイルのオブジェクト生成しています。

FileSearchメソッドを使って、添付ファイルのパスを取得しメールのオブジェクトに張り付ける処理を行っています。

FileSearchは後で説明を記載しています。

その後、添付ファイルがない場合、メールは送らず次のシートを処理するようになっています。

※発注連絡という想定なので、発注書の添付ファイルがなければ連絡はする必要がないから送らないという考え方です。

メールを送信する・Outlookを閉じる

最後にメールを送信します。

その後、作成したオブジェクトは破棄して次のメール作成・送信処理へ行きます。

メール添付ファイル取得 FileSearchメソッド

送信対象のファイル([yyyymmdd_シート名.拡張子]フォーマット)のファイル名を検索し配列に格納する処理です。

検索する場所は「..\VBA Outlookメール送信\添付ファイル」以下のみです。

他の場所に配置したファイルは添付ファイルとして検索されません。

コード

'==============================
'目的　　　 ：添付ファイルを検索し、ファイルのパスを取得する
'引数　　　 ：SearchText　　　　　　　　　検索するファイル名
'　　　　　　：SearchPath　　　　　　　　 検索するパス
'戻り値　　　: ファイルパスの配列
'==============================
Private Function FileSearch(SearchText As String, SearchPath As String) As String()
    Dim FileName As String
    Dim Cnt As Long
    Dim Files() As String                         'ファイルパス格納用配列
    
    '中身をダミー値でセット
    ReDim Files(0)
    Files(0) = "dummy"
    
    'ファイルを検索
    FileName = Dir(SearchPath & "\" & SearchText)
    
    Do While FileName <> ""
        
        'ファイル名を返却用配列に格納
        ReDim Preserve Files(Cnt) As String
        Files(Cnt) = SearchPath & FileName
        Cnt = Cnt + 1
        
        ' 次のファイル名を参照
        FileName = Dir()
    Loop

　　FileSearch = Files()
　　
End Function

解説

引数として受け取った検索フォルダ(SearchPath)を検索条件(SearchText)を元に検索します。

見つかったファイルのパスを配列に格納していきます。

検索条件に一致するファイルが見つからなくなったら配列を呼び出し元に返しています。

送信結果

送信結果はこんなメールです。

メール送信と言いつつガチガチに業務を想定したツールになってしまっています…

使えそうなところをアレンジしていってみてください。

・【エクセルVBA】Outlookでメールを作成・送信する方法
https://tonari-it.com/excel-vba-outlook-mail-send/
・VBAでメールを自動送信！エクセルマクロでoutlook操作する方法
http://www.fastclassinfo.com/entry/vba_outlook_sendmail
・シートを指定してRangeを取得する
https://www.relief.jp/docs/excel-vba-get-range-specific-sheet.html
・PDF発注書テンプレート
https://pdf.wondershare.jp/templates/purchase-order-template.html
・FileSystemObjectオブジェクト – FileExistsメソッド
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject10.htm
・ファイルの一覧を取得する
http://officetanaka.net/excel/vba/file/file07.htm

Excel VBA メール送信ツール(フリーメール)VBAでメール送信について紹介します。自動でメール送信するツールを作ってみました。今回はOutlookではなくフリーメー...

The post Excel VBA メール送信ツール(Outlook) first appeared on 文系出身のSEですが、何か.

Access VBA ダイアログからパス取得

LooseCarrot — Tue, 27 Nov 2018 22:50:02 +0000

VBAでファイルダイアログを開く処理について紹介します。

実際に作ったファイルはこちらからダウンロードできます。

ダイアログ用の参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Office 16.0 Object Libraryにチェックを付けておいてください。

16.0はバージョンに寄ります。

ファイルパス取得のダイアログコード

ファイルパス取得用のダイアログは以下のような書き方です。

処理の流れは以下の順です。

①ファイルダイアログを開く
②ファイルが選択されてらばパスをメッセージ表示
③選択されなければキャンセルのメッセージ表示

'=======================================
'目的　　　 ：選択したファイルのフルパスを取得
'=======================================
Private Sub GetFilePath_Click()

　　'変数定義
　　Dim intRet As Integer　　　　 'ダイアログ用変数
　　Dim FilePath As String　　　　 'フルパス用変数

　　With Application.FileDialog(msoFileDialogOpen)
　　　　.Title = "取込みファイル設定ダイアログ"
　　　　.Filters.Clear
　　　　.Filters.Add "Microsoft Office Excelファイル", "*.xls,*.xlsx,*.xlsm"
　　　　.FilterIndex = 1
　　　　
　　　　'複数ファイル選択を許可しない
　　　　.AllowMultiSelect = False
　　　　
　　　　'初期パスを設定
　　　　.InitialFileName = CurrentProject.Path
　　　　
　　　　'ダイアログを表示
　　　　intRet = .Show

　　　　'ファイルが選択された場合
　　　　If intRet <> 0 Then
　　　　　'パスを設定
　　　　　FilePath = Trim(.SelectedItems.Item(1))

　　　　　'パスを表示
　　　　　MsgBox FilePath
　　　　　
　　　　Else
　　　　　'ファイルが選択されていない場合
　　　　　MsgBox "キャンセルしました。"
　　　　　
　　　　End If
　　　　
　　End With
　　　　
End Sub

VBA C# オススメ参考書プログラミングの参考書でオススメの紹介をしていきます。それぞれ私が使っている言語のみです。 VBAのオススメ参考書をExc...

解説

FileDialogのShowでダイアログを出します。

ダイアログで選択したファイルがある場合intRetには結果引数として「-1」が返ってきます。

ファイルを選択しなかった場合、「0」が結果引数として返ってきます。

ファイルを選択した場合、SelectedItems.Item(1)にファイルのパスが取得されます。

例えば、ダイアログから取得したファイルパスを使ってエクセルをAccessに取込むというような処理に使えそうですね。

Access エクセル取込み複数シートAccessに複数シートをのエクセルを一括で取り込める機能が欲しかったのですが、ありませんでした。作ってみたので残しておきます。...

補足

・フィルタ設定

エクセル関係のファイルだけしか表示されないようにしています。

用途によっては「*」でも良いでしょう。

・複数ファイル選択許可

1ファイルだけに設定していますが、複数も可能です。

その場合、FilePath = Trim(.SelectedItems.Item(1))の番号は選択したファイル番号を設定する必要があります。

フォルダのパス取得のダイアログコード

フォルダパス取得用のダイアログは以下のような書き方です。

処理の流れは以下の順です。

①ダイアログを開く
②フォルダが選択されてればパスをメッセージ表示
③選択されなければキャンセルのメッセージ表示

'=======================================
'目的　　　 ：選択したフォルダのパスを取得
'=======================================
Private Sub GetFolderPath_Click()

　　Dim FolderPath As String　　　'フォルダパス用変数
　　
　　'ファイルダイアログを開く
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　If .Show = True Then
　　　　　　'パスを設定
　　　　　　FolderPath = .SelectedItems(1)
　　　　　　
　　　　　　'パスを表示
　　　　　　MsgBox FolderPath
　　　　End If
　　　　
　　　　'フォルダが選択されていない場合
　　　　If FolderPath = "" Then
　　　　
　　　　　　MsgBox "キャンセルしました。"
　　　　　　
　　　　End If
　　　　
　　End With
　　
End Sub

解説

FileDialogのShowでダイアログを出します。(ファイルパス取得と同じ)

ダイアログで選択した場合、Trueが返ってきます。

Trueの場合、SelectedItems(1)に選択したフォルダのパスがセットされています。

なので、FolderPathの変数に選択したパスをセットしています。

ロジックとしてFolderPathに何も入っていない場合、フォルダ選択をやめる以外はありません。

そのため、FolderPathが空白ならキャンセルされましたと表示をしています。

例えば、ダイアログを表示して指定したフォルダにAccessからtsvやcsvを出力するときなどに使えそうですね。

RecordSetからcsv、tsvファイルを出力するAccessのテーブルからtsvファイルを出力しようとしたところ、意外と簡単に出す方法がありませんでした。備忘録のために残してお...

補足

・複数フォルダ選択

複数フォルダ選択はできないようです。

・3種類の[ファイルを開く]ダイアログボックス
http://officetanaka.net/excel/vba/tips/tips154.htm
・[ファイルを開く]ダイアログボックスを表示する（GetOpenFilenameメソッド）
https://www.moug.net/tech/exvba/0060013.html

おすすめ参考書

■Excelマクロ

■Accessマクロ

Access VBA ダイアログからパス取得VBAでファイルダイアログを開く処理について紹介します。実際に作ったファイルはこちらからダウンロードできます。ダイアログ用の...

The post Access VBA ダイアログからパス取得 first appeared on 文系出身のSEですが、何か.

Access エクセル取込み複数シート

LooseCarrot — Sun, 25 Nov 2018 15:00:18 +0000

Accessに複数シートをのエクセルを一括で取り込める機能が欲しかったのですが、ありませんでした。

作ってみたので残しておきます。

実際に作ったファイルはこちらからダウンロードできます。

エクセル取込み – エクセル参照設定

まずAccessファイルにエクセルを取り込むときに、エクセルを操作しなければなりません。

そのため、エクセル操作ができるよう参照設定を行います。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Excel 16.0 Object Libraryを追加してください。

16.0はバージョンに寄ります。

エクセル取込みのコード

処理の流れは以下の順です。

①ファイルダイアログを開いて取込むエクセルを選択
②エクセルのシート名を取得
③シート毎にテーブルに取込む

※1テーブルをAccessに作っておく必要があります。
※2テーブル名とシート名は同じ必要があります。

'=======================================
'目的　　　 ：エクセルデータをインポートする
'=======================================
Private Sub ImportExcel_Click()

　　Dim MyDir As String
　　Dim InputFilePath As String
　　Dim i As Long
　　Dim mySheetCnt As Long
　　Dim SheetNames() As String
　　Dim wb As Workbook
　　
　　'自分の配置されているパスを取得
　　MyDir = Application.CurrentProject.Path
　　
　　'①----------ファイルダイアログを開いて取込むエクセルのパスを取得する----------
　　'取込みファイルパスを取得
　　InputFilePath = GetFilePath()
　　
　　'アラート表示をオフにする
　　DoCmd.SetWarnings False
　　
　　'取得パスが空白でなければ処理開始
　　If InputFilePath <> "" Then
　　
　　　　'②----------エクセルのシート名を取得----------
　　　　'エクセルを開く
　　　　Workbooks.Open (InputFilePath)
　　　　Set wb = ActiveWorkbook
　　　　
　　　　'配列の数を再定義
　　　　ReDim SheetNames(ActiveWorkbook.Sheets.Count)
　　　　
　　　　'シートを配列に取得
　　　　For i = 1 To ActiveWorkbook.Sheets.Count
　　　　　　SheetNames(i) = ActiveWorkbook.Sheets(i).Name
　　　　Next i
　　　　
　　　　'エクセルを閉じる
　　　　wb.Close False
　　　　
　　　　'③----------エクセルのシートを全て取り込む----------
　　　　'シート分取込みを実行
　　　　For i = 1 To UBound(SheetNames)
　　　　
　　　　　　'シート名がテーブル名に存在する場合、取込む　存在しない場合、スキップ
　　　　　　If DCount("*", "MSysObjects", "[Name]='" & SheetNames(i) & "'") > 0 Then
　　　　　　　　'対象テーブルを削除
　　　　　　　　DoCmd.RunSQL "DELETE * FROM " & SheetNames(i)
　　　　　　　　
　　　　　　　　'各マスタテーブルへエクセルデータを取込む
　　　　　　　　DoCmd.TransferSpreadsheet _
　　　　　　　　　　acImport, _
　　　　　　　　　　acSpreadsheetTypeExcel12Xml, _
　　　　　　　　　　SheetNames(i), _
　　　　　　　　　　InputFilePath, _
　　　　　　　　　　True, _
　　　　　　　　　　SheetNames(i) & "!"
　　　　　　 End If
　　　　Next i

　　　　MsgBox "取込みが完了しました。"
　　Else
　　　　MsgBox "取込をキャンセルしました。"
　　End If
　　
End Sub

補足

４９行目のテーブルデータ削除についてです。

以下の処理で一度テーブルデータを一括削除してからテーブルに取込んでいます。

削除しないとどんどん行数が増え続けていくためです。

DoCmd.RunSQL “DELETE * FROM ” & SheetNames(i)の中身

指定したテーブル名を引数に受け取っています。

そして指定したテーブルのレコードすべてを削除するようにしています。

VBA C# オススメ参考書プログラミングの参考書でオススメの紹介をしていきます。それぞれ私が使っている言語のみです。 VBAのオススメ参考書をExc...

エクセル取込み時に255文字で切れる

一つ問題がありました。

この処理だけでは文字数が255を超える場合、文字が切れてしまう可能性があります。

たとえ、文字型を「長いテキスト」にしたとしてもです。

長いテキストにすれば1GB分まで格納できるはずなのですが、なぜ?と思っていました。

原因は最初の8行が255文字以上でないと、自動でMAX文字数を255とAccess側で判断してしまうためだそうです。

この対応は他で行って公開できればと思います。

・xserver アクセスログ取得方法
https://www.xserver.ne.jp/manual/man_server_log.php
・Access2016で長いテキスト型でインポートエラー
https://answers.microsoft.com/ja-jp/msoffice/forum/msoffice_access-mso_winother/access2016%E3%81%A7%E9%95%B7%E3%81%84%E3%83%86/9e9d4345-0a9a-4004-9038-1da0150cf835?page=2
・もう一度学ぶMS-Access データ型
https://www.accessdbstudy.net/entry/20141027/p1#04020
・AccessVBAでテーブルを削除する３つの方法！コピペでOK！
https://eijiman.com/access-vba-table-delete/

おすすめ参考書

■Excelマクロ

■Accessマクロ

VBA C# オススメ参考書プログラミングの参考書でオススメの紹介をしていきます。それぞれ私が使っている言語のみです。 VBAのオススメ参考書をExc...

The post Access エクセル取込み複数シート first appeared on 文系出身のSEですが、何か.

Access SQL 複数(2,3,4)テーブルの結合(JOIN)

LooseCarrot — Fri, 23 Nov 2018 15:01:26 +0000

Accessで複数テーブルを結合する時に、書き方が分からず苦労しました。

他のサイトでも3テーブルの結合までは書いていたのですが、4つ以上の書き方がありませんでした。

備忘録として残しておきます。

実際に作ったファイルはこちらからダウンロードできます。

SQLの知識が必要なので、ゼロからはじめるデータベース操作がおすすめです。

Access SQLで2テーブルの結合

2つのテーブルを結合する場合の書き方です。

GoodsテーブルとRecipeテーブルを結合する場合を例にします。

抽出元

■Goodsテーブル

Goods_cd	Goods_name	price	calorry
101004	ビーフカツランチ	880	0

■Recipeテーブル

goods_cd	food_cd	necessary_num
101004	201110	5
101004	201111	5
101004	201112	10
101004	201114	30
101004	201115	5
101004	201116	10
101004	201124	50
101004	201143	5
101004	201145	120
101004	201146	5
101004	201147	50

SQL

SELECT
 Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Recipe.necessary_num
FROM Goods

LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd)

WHERE Goods.Goods_cd = 101004

ポイントとしては、

LEFT JOIN Recipe ON (Goods.Goods_cd = Recipe.goods_cd)

のようにON以降を()で囲む必要があることです。

Access SQLで3テーブルの結合

3つのテーブルを結合する場合の書き方です。

先ほどのGoodsテーブルとRecipeテーブルに加えて、

Foodsテーブルを結合する場合を例にします。

抽出元

■Foodsテーブル

foods_cd	ｆoods_name	supplier_cd
201110	濃口しょうゆ	301200
201111	ウスターソース	301200
201112	中濃ソース	301200
201114	サラダ油	301107
201115	ゴマ油	301107
201116	ラード	301106
201124	冷凍ほうれん草	301103
201143	パセリ	301103
201145	牛ロース肉	301108
201146	トマトケチャップ	301200
201147	ナチュラルポテト	301103

SQL

SELECT
Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Foods.ｆoods_name
,Foods.supplier_cd

FROM (Goods

LEFT JOIN Recipe 
ON (Goods.Goods_cd = Recipe.goods_cd))

LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd)

WHERE Goods.Goods_cd = 101004

ポイントはFROM直後～一つ目のJOINが終わるところまでを()で囲むところです。

FROM (Goods
LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd))

Access SQLで4テーブルの結合

3つのテーブルを結合する場合の書き方です。

先ほどのGoodsテーブル、Recipeテーブル、Foodsテーブルに加えて、

Supplierテーブルを結合する場合を例にします。

抽出元

■Supplierテーブル

supplier_cd	supplier_name
301103	ライヘルフ
301106	流通パートナーズ
301107	全食
301108	大地
301200	キッコーマン

SQL

SELECT
Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Foods.ｆoods_name
,Foods.supplier_cd
,Supplier.supplier_cd
,Supplier.supplier_name

FROM ((Goods

LEFT JOIN Recipe 
ON (Goods.Goods_cd = Recipe.goods_cd))

LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd))

LEFT JOIN Supplier
ON (Foods.supplier_cd = Supplier.supplier_cd)

WHERE Goods.Goods_cd = 101004

ポイントはFROM直後～二つ目のJOINが終わるところまでを()で囲むところです。

FROM ((Goods
LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd))
LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd))

結合テーブルが増えた時の書き方パターン

結合するテーブル数が5、6、7…と増えても()で囲む数が増えていくだけです。

2,3,4テーブルはすべてテーブル単位の()に色付けして分かりやすくしています。

これを覚えておけば問題ありません。

・Access の SQL で 3つ以上の表を join する
https://qiita.com/Takashi_Noboru/items/f188eddb241d18896795
・【Access VBA】【SQL】　3つ以上の表を結合⇒LEFT JOIN
http://tibirobo.jpn.org/?p=91
・複数テーブルをつなげてレコードを結合する《ユニオンクエリ》
https://www.helpforest.com/access/ob_query/ac050007.htm

おすすめ参考書

■Excelマクロ

■Accessマクロ