ExcelとOutlookの連携パート3【ファイルを添付する】

The following two tabs change content below.

• この記事を書いた人
• 最新の記事

taka

あることがキッカケでVBAを独学で勉強しました、今ではブログを通してVBAでできることを解説しつつ、VBAや他の言語の勉強、ブログ運営の勉強をしています(^^♪

最新記事 by taka (全て見る)

• 『雑記』最近の私の話～ - 2019年9月26日
• 【動画】自作パソコン構成変更！ケースをNZXT　H500に交換しました！ - 2019年6月5日
• VBA 『Array関数』指定した要素で配列を作成する - 2019年5月23日
• 「動画」初完全ワイヤレスイヤホン『Jabra Elite Active 65t』 - 2019年5月17日
• VBA　日付で令和を簡単に判定してみよう - 2019年5月7日

ExcelとOutlookの連携パート3【ファイルを添付する】

どうも、takaです、今回はExcelとOutlookの連携の三回目です(^^♪

【ExcelとOutlookの連携パート1】ではExcelの名簿をもとに一斉にメールを送る方法を

E-VBA

VBA ExcelVBAとOutlookの連携　パート1

どうもtakaです(^^♪さて、ExcelとOutlookが連携するという結構コアな検索でこのE-VBAにいらっしゃる方が結構お見掛けします(笑)ExcelとOutlookを連携させると何ができる...

【ExcelとOutlookの連携パート2】では件名によってメールをフォルダ分けする方法を

E-VBA

ExcelとOutlookの連携　パート2

ExcelとOutlookの連携　パート2すんごい久しぶりの企画です(笑)確認したら3/19に一度ご紹介しただけだったんですね～長らくお待たせしてしまいまして申し訳ありません。...

それぞれご紹介してきました(^^)

そして今回、第三弾は【Excelからファイルを添付する方法】をご紹介します(^^)/

今回用意するフォーム

今回は簡単にメールフォームを作成してみましたのでそれも一緒に紹介させてください( ^ω^ )

今回は下記のようなフォームを作成いたしました(^^♪TextBoxのオブジェクト名は画像の通りです。

このフォームでは一応【Cc】や【Bcc】も設定ができる用になっています(笑)

用意したコントロール

今回用意したコントロールは

1. TextBoxコントロール・・6つ
2. コマンドボタン 　・・・ 2つ

です。適当に作っていたらTextBoxの順番がおかしくなってました(;´∀｀)←

ファイルを添付するコード

VBAでOutlookにファイルを添付させるには【Attachmentsオブジェクト】の【Addメソッド】を使用します。Addメソッドを使用する場合は添付ファイルのフルパスでファイルを指定する必要がありますのでご注意ください( ^ω^ )

Private Sub CommandButton1_Click()
'送信ボタンの処理
   On Error GoTo Error1

   Dim trSh As Worksheet
   Dim res As Integer
   Dim oApp As Object
   Dim myNameSpace As Object
   Dim myFolder As Object
   Dim objMAIL As Object
   
   If TextBox4.Value = "" Then
   MsgBox " 宛先が空欄です｡"
   Exit Sub
   End If
   
    If TextBox2.Value = "" Then
     res = MsgBox("件名が空欄です、よろしいですか?", vbYesNo)
      If res = vbNo Then Exit Sub
   End If
      Set oApp = CreateObject("Outlook.Application") 'outlook 起動
      Set objMAIL = oApp.CreateItem(0) 'メール作成
      
         objMAIL.To = TextBox4.Value '宛先
         objMAIL.CC = TextBox5.Value 'CC
         objMAIL.BCC = TextBox6.Value 'BCC
         objMAIL.Subject = TextBox2.Value  '件名
         objMAIL.Body = TextBox3.Value '本文
         
         If TextBox1.Value = "" Then
         Else
         objMAIL.Attachments.Add (TextBox1.Value)
         End If
         
         objMAIL.send  'メール送信
    MsgBox "送信しました"
Exit Sub
Error1:     'エラー処理

    MsgBox "エラー番号:" & Err.Number & vbLf & _
    "エラー内容：" & Err.Description & vbLf & _
    "ヘルプファイル名" & Err.HelpContext & vbLf & _
    "プロジェクト名：" & Err.Source, vbOKOnly + vbCritical, "エラー"
    
  Exit Sub
    
    
End Sub
Private Sub CommandButton2_Click()
'添付ボタンの処理
'添付ファイルの指定はフルパスが必要

  Dim objFS           As New FileSystemObject
    Dim strPath         As String
    Dim ofdFolderDlg    As Office.FileDialog

    ' 初期フォルダの設定
    If Len(strPath) > 0 Then
        ' 末尾の"\"削除
        If Right(strPath, 1) = "\" Then
            strPath = Left(strPath, Len(strPath) - 1)
        End If

        ' フォルダ存在チェック
        If Not objFS.FolderExists(strPath) Then
            strPath = ThisWorkbook.Path
        End If
        Set objFS = Nothing
    Else
        strPath = ThisWorkbook.Path
    End If

    ' フォルダ選択ダイアログ設定
    Set ofdFolderDlg = Application.FileDialog(msoFileDialogFilePicker)
    With ofdFolderDlg
        ' 表示するアイコンの大きさを指定
        .InitialView = msoFileDialogViewDetails
        ' フォルダ初期位置
        .InitialFileName = strPath & "\"
        ' 複数選択不可
        .AllowMultiSelect = False
    End With

    ' フォルダ選択ダイアログ表示
    If ofdFolderDlg.Show() = -1 Then
        ' フォルダパス設定
     TextBox1.Text = ofdFolderDlg.SelectedItems(1)
    End If

    Set ofdFolderDlg = Nothing
    Exit Sub
End Sub

ダウンロード

当サイトの免責事項をお読みになってからお使いください。

Excel×Outlook3

1 file(s) 21.45 KB

Download

フォロー・チャンネル登録お願いします

VBA以外についてのブログはこちら↓

■Twitterフォロー

■YouTubeチャンネル登録

ファイルやコードの利用、WEBサイトの利用について

Sponsored Link