No.7ベストアンサー
- 回答日時:
>できましたー!
>ありがとうございます。
それはよかったです。今回は、まさかの、そのまさかでした。
やっと来ましたね。ほっとしています。
>一点だけ、添付ファイルが画像データとPDFの二種類あるのですが、PDFのみ抜き出しとかできますか?
最後の行から遡って、'** でつけたように、If ~ End If で挟みます。
今は、pdf ファイルのみというスタイルになっています。
画像データとpdf 2つ以上がある時に、pdf ファイルのみという方法ですと、少し複雑になります。
Sub SaveEachItem()
・
・
For Each att In AttachedItems
With att
If StrConv(.FileName, vbLowerCase) Like "*.pdf" Then '**
.SaveAsFile strAttPath & "\" & .FileName
End If '**
End With
Next
Beep
EndLine:
Set objFS = Nothing
Set AttachedItems = Nothing
End Sub
No.6
- 回答日時:
>つぎはSet objItem = objOL.Selection(1)のところで
>「配列のインデックスが範囲にありません」とでてきました。
原因は、メールを一つも選択されていないということしか思い浮かびません。それは、想定されていませんでした。また反対に、複数のメールの切り出しも考えてはいませんが、それについては、変更は可能です。また、今のマクロを分割していくという形にはなります。
-> If objOL.Selection.
Set objOL = Outlook.ActiveExplorer
If objOL.Selection.Count < 1 Then MsgBox "メールを選択されていない模様です", vbExclamation: Exit Sub '一行挿入
Set objItem = objOL.Selection(1) 'エラーの出た箇所の手前の行↑
sTitle = Trim(objItem.ConversationTopic)
fName = Left(strMailPath & sTitle, 250) & ".msg" '254文字まで
これでどうでしょうか。
できましたー!
ありがとうございます。
一点だけ、添付ファイルが画像データとPDFの二種類あるのですが、PDFのみ抜き出しとかできますか?
No.5
- 回答日時:
前回のコードの全面的に上書きをしてみてください。
確かに、SaveAs のエラーは、理にかなっています。そのまま件名(subject:)をファイル名にするのは無理がありました。
ファイル名の規則にしたがつて、チェックカー(ユーザー定義関数)をつけることにしました。
'//--
Sub SaveEachItem()
'OutLook メールを切り出すマクロ
Dim objFS As Object: Set objFS = CreateObject("Scripting.FileSystemObject")
'メール本体の格納フォルダ
Dim strMailPath: strMailPath = "C:\Temp\Mail"
If Right(strMailPath, 1) <> "\" Then strMailPath = strMailPath & "\"
'添付ファイルの格納フォルダ
Dim strAttPath: strAttPath = "C:\Temp\AttachedFiles"
If Right(strAttPath, 1) <> "\" Then strAttPath = strAttPath & "\"
'フォルダチェック
If objFS.FolderExists(strMailPath) = False Then
MsgBox strMailPath & "がありません。", vbExclamation
GoTo EndLine
End If
If objFS.FolderExists(strAttPath) = False Then
MsgBox strAttPath & "がありません。", vbExclamation
GoTo EndLine
End If
'/切り出しマクロ(選択ファイルのみ1つ)
Dim objItem As MailItem
Dim AttachedItems As Attachments
Dim att As Attachment
Dim objOL As Explorer
Dim fName As Variant '必ずVariant 型 '**
Dim sTitle As String '**
Set objOL = Outlook.ActiveExplorer
Set objItem = objOL.Selection(1)
sTitle = Trim(objItem.ConversationTopic)
fName = Left(strMailPath & sTitle, 250) & ".msg" '254文字まで
fName = fCheckFileName(fName)
If VarType(fName) <> vbString Then MsgBox fName, vbCritical: Exit Sub
objItem.SaveAs fName
Set AttachedItems = objItem.Attachments
If AttachedItems.Count = 0 Then
'添付ファイルがない場合のメッセージ、普段は不要なので、コメントアウト
' MsgBox "該当メールには、添付ファイルはありません。", vbExclamation
GoTo EndLine
End If
For Each att In AttachedItems
With att
.SaveAsFile strAttPath & "\" & .FileName
End With
Next
Beep
EndLine:
Set objFS = Nothing
Set AttachedItems = Nothing
End Sub
Function fCheckFileName(ByVal strFn As String)
'保存ファイル名チェッカー
Dim IllChars As String
IllChars = "/:,;*?<>|"""""
Dim mPath As String
Dim i As Long, j As Long
Const ErrRef As Long = 2023
Const ErrName As Long = 2029
If Len(strFn) > 254 Then
fCheckFileName = CVErr(ErrName)
Exit Function
End If
i = InStrRev(strFn, "\")
If i > 0 Then
mPath = Mid$(strFn, 1, i)
If Dir(mPath, vbDirectory) = "" Then
fCheckFileName = CVErr(ErrRef)
Exit Function
End If
strFn = Mid$(strFn, i + 1)
End If
Do Until Not strFn Like "*[" & IllChars & "]*"
j = j + 1
strFn = Replace(strFn, Mid$(IllChars, j, 1), "_")
If j > Len(IllChars) Then Exit Do
Loop
fCheckFileName = mPath & strFn
End Function
'//--
何回もありがとうございます。
つぎはSet objItem = objOL.Selection(1)のところで
「配列のインデックスが範囲にありません」とでてきました。
なんてコーディングはむずかしいんだ。。。
No.4
- 回答日時:
こんばんは。
#3のお礼欄の互換については、一応見てみましたが、特に引っかかるものはなさそうです。
>meが完了すると”.SaveAS”のところでもひっかかりました><
違うエラーのメッセージが出るはずです。
objItem.SaveAs strMailPath & objItem & ".msg"
たぶん、その部分が通るメールとそうでないメールがあるはずです。
おそらく、それは、ファイル名に向いていない名前をつけようとしたからです。
メールのタイトル名が、255文字以上、「 \ / , ; : * ? " < > | 」が含まれる、他、特別なシステムで使用する単語があれば、保存できなくなります。
それをどのように解決するか、決めていませんが、例えば、使っていけない記号を削除する方法があります。もう一つは、ファイル名を一律、何かまったく別な名前で、付ける方法です。最初のほうが楽かもしれません。
とりあえず、本日は、ここまでにしてください。
こんにちは。
Saveasのところででるエラーは、
「オブジェクトは、このプロパティまたはメソッドをサポートしてません。」とでます。
送られてきたメールのタイトルに「/」が日付として入っております。
このフォーマットは変わらないので消さないといけないのですね!
毎回ありがとうございます。
No.3
- 回答日時:
こんにちは。
>Meの部分でひっかかりました!これを調べないといけないのですね!
早速の返事ありがとうございました。
それだけで十分です。ご迷惑を掛けました。
直しましたので、これを全部、上書きにしてみてください。
変更部分は、objOLという部分です。
後の条件は、#1と同じです。聞く所によると、Excel以外は、VBAは新たな局面に変わっているという話も聞いたことがあります。
大したマクロではないとは思いますが、これでダメだったら、私の方は、一旦、Outlook2007をアンインストールして、上位バージョンに変更しますので、もしダメでしたら、少しお時間をいただくことになりそうです。
'//-
Sub SaveEachItem()
'OutLook メールを切り出すマクロ
Dim objFS As Object: Set objFS = CreateObject("Scripting.FileSystemObject")
'メール本体の格納フォルダ
Dim strMailPath: strMailPath = "C:\Temp\Mail"
If Right(strMailPath, 1) <> "\" Then strMailPath = strMailPath & "\"
'添付ファイルの格納フォルダ
Dim strAttPath: strAttPath = "C:\Temp\AttachedFiles"
If Right(strAttPath, 1) <> "\" Then strAttPath = strAttPath & "\"
'フォルダチェック
If objFS.FolderExists(strMailPath) = False Then
MsgBox strMailPath & "がありません。", vbExclamation
GoTo EndLine
End If
If objFS.FolderExists(strAttPath) = False Then
MsgBox strAttPath & "がありません。", vbExclamation
GoTo EndLine
End If
'/切り出しマクロ(選択ファイルのみ1つ)
Dim objItem As MailItem
Dim AttachedItems As Attachments
Dim att As Attachment
Dim objOL As Explorer '**新たに書き換えました。
Set objOL = Outlook.ActiveExplorer
Set objItem = objOL.Selection(1)
objItem.SaveAs strMailPath & objItem & ".msg"
Set AttachedItems = objItem.Attachments
If AttachedItems.Count = 0 Then
'添付ファイルがない場合のメッセージ、普段は不要なので、コメントアウト
' MsgBox "該当メールには、添付ファイルはありません。", vbExclamation
GoTo EndLine
End If
For Each att In AttachedItems
With att
.SaveAsFile strAttPath & "\" & .FileName
End With
Next
EndLine:
Set objFS = Nothing
Set AttachedItems = Nothing
End Sub
何度も何度もありがとうございます。
が、すみません。
meが完了すると”.SaveAS”のところでもひっかかりました><
https://msdn.microsoft.com/ja-jp/library/office/ …
互換性でだめなのか。。。
saveas2って言うものがあるみたいですが。
できないーーーw
No.2
- 回答日時:
>オブジェクトは、このプロパティまたはメソッドをサポートしていません。
とでました。この部分は、どこになるか分かりますか?
短いコードですから、F8 でマクロを1コマずつステップしていけば、エラーの出る部分が分かります。
私は、基本的に、Office 2010 を使っているのですが、Outlook だけは、都合で、バージョンアップしていないのです。インストールしていないのに気がついたというべきだったかもしれません。
やはり、Meの部分でしょうか?この部分なら、直せますが、他は、旧Outlook と新Outlook のVBAの違う点を探さなくてはなりませんので、なるべく特定化できれば、解決は早いと思います。
私は、Office 2013もあるのですが、今のPCには入れていないのと、現在のOutlook をアンイストールして、新たに入れるということまでは、できればしたくないのです。なんとか、その原因の部分だけをご自身で突き止めていただくことはできませんかしら。
>また、このコーディングに関してはOutlookのVBAですが、VB.netではできないでしょうか?
VB.Net 自体よりも、現在のマクロそのものが、Outlookの閲覧に依存したものですから、Outlookにアドインにする以外では、通常のVBAマクロという方法しかないはずです。
ただ、もしかしたら、世界の中では、そうしたツールを作っている人がいるかもしれません。
>やはり、Meの部分でしょうか?この部分なら、直せますが、他は、旧Outlook と新Outlook のVBAの違う点
>を探さなくてはなりませんので、なるべく特定化できれば、解決は早いと思います。
Meの部分でひっかかりました!これを調べないといけないのですね!
見つけれるかなー
No.1
- 回答日時:
最初に、私はOutlook のVBAなどはほとんど知らないにも同然ですが、Microsoft のページや他のサイトを見ながら作ってみました。
>Outlookから「:C¥メール」にmsgファイルを手動で移し、そこからVBにて「:>C¥添付ファイル」に添付ファイルのみを取り出したいです。
手動?、Outlook でメールを開いて、適当の受信メールを選択して取り出してしまいます。その時に、そのメールから、添付ファイルを別途抜き出すという仕組みです。
ただし、さすがに、ルートフォルダに、フォルダを設けるという大胆さがないので、今回は、C:\Tempフォルダの中に作りました。
strMailPath = "C:\Temp\Mail"
strAttPath = "C:\Temp\AttachedFiles"
*なるべく英語のほうが良いと思います。
これは、任意に時期責任で変更をお願いします。なお、開発は、Outlook 2007 で、
ThisOutlookSession モジュールです。標準モジュールですと、一部、変更しなくてはなりません。(Meと書いている部分です)
'//
Sub SaveEachItem()
'OutLook メールを切り出すマクロ
Dim objFS As Object: Set objFS = CreateObject("Scripting.FileSystemObject")
'メール本体の格納フォルダ
Dim strMailPath: strMailPath = "C:\Temp\Mail"
If Right(strMailPath, 1) <> "\" Then strMailPath = strMailPath & "\"
'添付ファイルの格納フォルダ
Dim strAttPath: strAttPath = "C:\Temp\AttachedFiles"
If Right(strAttPath, 1) <> "\" Then strAttPath = strAttPath & "\"
'フォルダチェック
If objFS.FolderExists(strMailPath) = False Then
MsgBox strMailPath & "がありません。", vbExclamation
GoTo EndLine
End If
If objFS.FolderExists(strAttPath) = False Then
MsgBox strAttPath & "がありません。", vbExclamation
GoTo EndLine
End If
'/切り出しマクロ(選択ファイルのみ1つ)
Dim objItem As MailItem
Dim AttachedItems As Attachments
Dim att As Attachment
Set objItem = Me.ActiveWindow.Selection(1)
objItem.SaveAs strMailPath & objItem & ".msg"
Set AttachedItems = objItem.Attachments
If AttachedItems.Count = 0 Then
'添付ファイルがない場合のメッセージ、普段は不要なので、コメントアウト
' MsgBox "該当メールには、添付ファイルはありません。", vbExclamation
GoTo EndLine
End If
For Each att In AttachedItems
With att
.SaveAsFile strAttPath & "\" & .FileName
End With
Next
EndLine:
Set objFS = Nothing
Set AttachedItems = Nothing
End Sub
回答ありがとうございます。
そのままフォルダを作成させて頂きOutlook2013にてThisOutlookSession(コード)にてコピーさせて頂きましたが、オブジェクトは、このプロパティまたはメソッドをサポートしていません。とでました。
申し訳ありません。。。
また、このコーディングに関してはOutlookのVBAですが、VB.netではできないでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
誕生日にもらった意外なもの
みなさんがもらった誕生日プレゼントで面白いものがあったらぜひ教えてください!
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
VBSでファイルを指定のフォルダに保存
Visual Basic(VBA)
-
OUTLOOK VBA 指定フォルダ内のメール添付ファイル2つをエクセルのシートにまとめるマクロ
Visual Basic(VBA)
-
アウトルックが起動しているかどうかを取得するには?
Visual Basic(VBA)
-
-
4
Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したい
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
特定のPCだけ動作しないVBAマク...
-
Excel・Word リサーチ機能を無...
-
一つのTeratermのマクロで複数...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
エクセルに張り付けた写真のフ...
-
エクセルで特定の列が0表示の場...
-
特定文字のある行の前に空白行...
-
ExcelのVBA。public変数の値が...
-
Excel マクロでShearePoint先の...
-
wordを起動した際に特定のペー...
-
TERA TERMを隠す方法
-
マクロ実行時、ユーザーフォー...
-
エクセルで別のセルにあるふり...
-
ExcelVBAでPDFを閉じるソース
-
Worksheet_Change(ByVal Target...
-
エクセルマクロでワードの一ペ...
-
VBA アドインについて お詳しい...
-
VBAのIF分で時間指定の条件式の...
-
Excel_マクロ_現在開いているシ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
特定のPCだけ動作しないVBAマク...
-
Excel・Word リサーチ機能を無...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
ExcelのVBA。public変数の値が...
-
エクセルに張り付けた写真のフ...
-
Excel VBAからAccessマクロを実...
-
Excel マクロでShearePoint先の...
-
特定文字のある行の前に空白行...
-
エクセルで別のセルにあるふり...
-
TERA TERMを隠す方法
-
wordを起動した際に特定のペー...
-
マクロ実行時、ユーザーフォー...
-
ExcelVBAでPDFを閉じるソース
-
【EXCEL VBA】オートシェイプを...
-
Excel_マクロ_現在開いているシ...
-
EXCELマクロでのThisisWor...
-
ソース内の行末に\\
おすすめ情報