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

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

ただいまの
回答率

90.12%

Outlook VBA 受信メールの添付ファイルを新規メールへ添付したい

解決済

回答 1

投稿

  • 評価
  • クリップ 1
  • VIEW 2,991

thachi

score 12

現在Windows10(64bit)のOutlook2016で以下の処理をVBAで実装しております。
・特定のフォルダに受信されたメールの添付ファイルを、新規作成するメールへ添付して送信

下部のように書いたプログラムを実行すると
nMail.Attachments.Add vAttachments
の部分でエラーになります。
エラー内容は「ファイルが見つかりません。パスとファイル名が正しいかどうかを確認してください。」です。

Outlook上では該当の受信メールの添付ファイルは正常に開けて、保存もできます。
同じプログラムで1日前まで動いていたのですが、突然動かなくなりました。

また、新規作成メールへ添付する際に、パス指定だとエラー無く添付することが出来ます。

そのため1度ローカルへ保存しようと試みましたが、エラーになります。
エラー内容は「添付ファイルを保存できません。この操作を行うために必要なアクセス権がありません。」です。

稚拙な文となってしまい申し訳ございませんが、八方塞状態です。
お知恵を拝借できないでしょうか。
他にも必要な情報等ありましたら、ご質問ください。
よろしくお願いします。

以下実装しているプログラムの抜粋となります。

'新規メールの作成前に mITEM に受信メールを設定しておく

'新規メールの作成
Dim nMail As Outlook.MailItem
Set nMail = Application.CreateItem(0)

'受信メールから添付ファイルを取得
Dim vAttachments As Variant
vAttachments = mITEM.Attachments.Item(1)

'新規メールに 件名、宛先、本文、添付ファイルをセット
nMail.Subject = "件名"
nMail.To = "hoge@hoge.hoge"
nMail.Body = "本文です。"

'パス指定だと添付できる
nMail.Attachments.Add "C:\Users\test.pdf"

'1度ローカルへ保存しようとするがエラーになる
'mITEM.Attachments.Item(1).SaveAsFile "C:\Users\jushintemp.pdf"

'受信メールの添付ファイルが新規作成メールに添付できない  
nMail.Attachments.Add vAttachments  '←ここでエラー

'送信
nMail.Send

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+2

AttachmentオブジェクトをAttachments.Addするのは、こちらで実行してみてもエラーになりました。
申し訳ないですが、原因は分かりません。(動いていたとの事なので、OfficeのUpdateでNGになったのでしょうか・・・)

とりあえず、ローカルに保存するアイデアで問題ないと思います。
保存に失敗するのは”C:\Users”フォルダの書き込み権限がないからです。
ですので、代わりにユーザー別の一時ファイルフォルダ等を使用すればよいです。

以下、参考までに添付ファイルコピー関数を貼っておきます。

'添付ファイルをコピー
Sub CopyAttachments(oSourceMail, oTargetMail)
   Set FSO = CreateObject("Scripting.FileSystemObject")
   '一時ファイルフォルダ取得
   Set fldTemp = FSO.GetSpecialFolder(2)

   '添付ファイルコピー開始
   For Each oItem In oSourceMail.Attachments
      '一時ファイル保存
      sFile = FSO.BuildPath(fldTemp.Path, oItem.FileName)
      oItem.SaveAsFile sFile
      '添付ファイル追加
      oTargetMail.Attachments.Add sFile, , , oItem.DisplayName
      '一時ファイル削除
      FSO.DeleteFile sFile
   Next

   Set fldTemp = Nothing
   Set FSO = Nothing
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/08/22 07:40

    ご回答ありがとうございます。

    そちらでもエラーが出ましたか。
    やはり安定して稼動させるのは難しそうです。

    保存についてもご回答、サンプルのご教示ありがとうございます。
    こちらの環境で試したところ正常に保存でき、保存したファイルを添付することを確認できました。

    OutlookのVBAに関してはなかなか情報が少なく難儀しておりましたが助かりました。
    ありがとうございました。

    キャンセル

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

  • ただいまの回答率 90.12%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる