outlookvbaについての質問
- outlookvbaを使用して、選択中のメールの受信日時や送信者などを取得したいが、エラーが発生する。
- Sub Sample()内で、GetNamespace関数やActiveExplorerメソッドを使用しているが、エラーが発生する。
- 実行時エラー '438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。
- ベストアンサー
outlookvba
outlookvbaについて教えてください 現在選択中（現在開いている）メールの受信日時や送信者などをｖｂａで取得したいのですが 間違っているようで、エラーになります。 Sub Sample() Dim myNaSp As NameSpace Dim myOlSel As Outlook.Selection Dim myItem As MailItem Set myNaSp = GetNamespace("MAPI") Set myOlSel = Application.ActiveExplorr.Selection ’ここでエラー Debug.Print myItem.ReceivedTime Debug.Print myItem.SenderName Debug.Print myItem.To Debug.Print myItem.Subject Set myNaSp = Nothing End Sub エラーの部分で、 実行時エラー '438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。 になります。 修正箇所などご教授いただければ助かります。 よろしくお願いします。
- vepkkaocnbj
- お礼率100% (37/37)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
WinXPSP3, Outlook2007でやってみました。 Set myOlSel = Application.ActiveExplorr.Selection ’ここでエラー を Set myOlSel = Application.ActiveExplorer.Selection '綴り修正 Set myItem = myOlSel(1) '追加 にしたらうまく動きました。 お試しください。
関連するQ&A
- ダイレクトに目的のフォルダを指定する方法は？
全てのフォルダをループするのではなく、 ダイレクトに目的のフォルダを指定する方法はありますか？ アクセスからアウトルックの該当のフォルダの中身を取得したいのですが 下記コードで目的通り取得できるのですが コードが遠回りの気がします。 ダイレクトにフォルダを指定する方法があれば教えてください。 Sub test() Dim myNaSp As Namespace Dim myFolder As MAPIFolder Dim mySecFolder As MAPIFolder Dim myThrFolder As MAPIFolder Dim FolderName As String Dim myItem As MailItem Dim myindex As Long Set cn = CurrentProject.Connection Set myNaSp = GetNamespace("MAPI") For Each myFolder In myNaSp.GetDefaultFolder(olFolderInbox).Folders For myindex = 1 To myFolder.Items.Count Set myItem = myFolder.Items(myindex) If myFolder.Name = "ｔｅｓｔフォルダ" Then Debug.Print myItem.Body End If Next Next Set myNaSp = Nothing Set myFolder = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- GetNamespaceで、コンパイルエラー
アクセスからアウトルックの受信メールを操作しようとしているのですが Private Sub test1() Dim requestsFolder As MAPIFolder Dim appNameSpace As Namespace Dim requestMailItem As MailItem Dim i As Integer '受信フォルダの取得 Set appNameSpace = Application.GetNamepace("MAPI") Set requestsFolder = appNameSpace.GetDfaultFolder(olFolderInbox) ・ ・ ・ End Sub これを実行すると GetNamespaceで、コンパイルエラーになります。 Microsoft Outlook ○.○ Object Library で、アウトルックに参照設定はしているのですが アクセスからはGetNamespaceは使えないのでしょうか？
- ベストアンサー
- オフィス系ソフト
- ＶＢＡで全ての受信トレイの数ではなく受信メールの数
ＶＢＡで全ての受信トレイの数ではなく受信メールの数を取得する方法は？ Sub めーる数() Dim myNaSp As NameSpace Dim myFolder As MAPIFolder Set myNaSp = GetNamespace("MAPI") Set myFolder = myNaSp.GetDefaultFolder(olFolderInbox) Debug.Print myFolder.Items.Count Set myNaSp = Nothing Set myFolder = Nothing End Sub このコードだと、「受信トレイ」のメールの数しか取得できません。 フォルダは画像のように、サブフォルダがあります。 この場合、全ての受信メール（受信トレイ+サブフォルダ）の数を取得するにはどうすればいいでしょう？
- ベストアンサー
- オフィス系ソフト
- EXCELの配列で
メールの本文を1行づつよみとってEXCELへ書き出そうと思っています。 Sub getMail1() Dim myOl As New Outlook.Application Dim dFolder As MAPIFolder Dim myItem As MailItem Dim delItem As MailItem Dim myRecipient As Recipient Dim i As Long, j As Long Const mAddress = 0, mTel = 1, mName = 2, mAge = 3 Set dFolder = myOl.GetNamespace _ ("MAPI").Folders("個人用フォルダ").Folders("単発") i = 1 On Error Resume Next For Each myItem In dFolder.Items i = i + 1 Set delItem = myItem.Reply For Each myRecipient In delItem.Recipients If InStr(1, myRecipient.Address, "@", vbBinaryCompare) _ <> 0 Then Exit For End If Next delItem.Delete With ActiveSheet myBody = Split(myItem.Body, vbCrLf) .Cells(i, 1).Value = myRecipient.Address .Cells(i, 2) = myItem.SenderName .Cells(i, 3) = myItem.Subject .Cells(i, 4) = myItem.ReceivedTime For j = 0 To UBound(myBody) i = i + 1 On Error Resume Next .Cells(i, 1) = myBody(j) .Cells(i, 1).MergeCells = True Next End With i = i + 1 Next Set myOl = Nothing End Sub このようなコードを書いて書き出すことは出来たのですが配列が縦になってしまいます。 横に配列したいのですが教えてください。 伊藤太郎 東京都 03-3123-4567を 伊藤太郎 東京都 03-3123-4567 としたいです。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- OutlookVBAは他のVBAと違って入力支援は無いのですか？
Outlook2003を使っています。 たとえば、 Public Sub AllMaildisp() Dim mlitem As NameSpace Dim fd As MAPIFolder Dim cnt As Long Set mlitem = GetNamespace("MAPI") ' 対象メールボックス Set fd = mlitem.Folders("電子メール").Folders("受信トレイ") For cnt = 1 To 3 'For cnt = 1 To fd.Items.Count Debug.Print fd.Items(cnt).Subject Debug.Print fd.Items(cnt).Body Debug.Print fd.Items(cnt).ReceivedByName Debug.Print fd.Items(cnt).ReceivedTime Debug.Print fd.Items(cnt).To Debug.Print fd.Items(cnt).CC Debug.Print fd.Items(cnt).BCC Next cnt End Sub のときにfd.Items(cnt). と入力したら、ExcelのVBAとかだとその次のプロパティの候補が表示されると思いますが表示されません。 この場合 既に書いてありますが、CC とか BCC とか Toとかだと思います。 表示する方法はありますか？
- 締切済み
- その他（プログラミング・開発）
- 実行時エラー配列のインデックスが範囲内にありません
アウトルックvbaで、受信トレイのメールをすべてループして、 該当のメールを削除するコードを作ったのですが 連続して削除しようとすると 実行時エラー-2147352567 「配列のインデックスが範囲内にありません」になります。 ------------------------------------------------------------------- Sub test() Dim requestsFolder As MAPIFolder Dim appNameSpace As NameSpace Dim requestMailItem As MailItem Dim i As Integer Dim j As Long '削除した個数を数える Set appNameSpace = Application.GetNamespace("MAPI") Set requestsFolder = appNameSpace.GetDefaultFolder(olFolderInbox) j = 1 For i = 1 To requestsFolder.Items.Count Set requestMailItem = requestsFolder.Items.Item(i) If requestMailItem.Subject Like "*キャンペーン*" Then '削除済みフォルダへ移動する requestMailItem.Delete Debug.Print j & "個目削除" j = j + 1 End If Next i End Sub ------------------------------------------------------------------- このコードを使っています。 エラーになるのは、 2個目削除後だったり、３個目削除後だったりさまざまで安定しません。 このエラーになる原因がわからないので教えていただけますか？ アウトルックのエラーというより、 Fornextステートメントのエラーという気がします。 ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- OutLookVBA 指定のフォルダをアクティブ化
こんばんは、よろしくお願いいたします。 OUTLOOK VBAで指定のフォルダをアクティブにするコードが分かりません。 Windows:VISTA OutLook:2007 ○.Display とすると、別ウィンドウが立ち上がってそのフォルダが表示されます。 ○.Activate とするとエラーになります。 別ウィンドウではなくアクティブフォルダが遷移する、とするにはそう すればいいでしょうか？ ご指導お願いいたします。 Sub foldpl() Dim ns As NameSpace Dim mf As MAPIFolder Set ns = GetNamespace("MAPI") Set mf = ns.Folders("個人用フォルダ").Folders("送信済みアイテム") mf.Display '別ウィンドウで表示されてしまします Set mf = Nothing Set ns = Nothing End Sub
- ベストアンサー
- その他MS Office製品
- 一通ずつ処理したい（アウトルックVBA）
下記のようなＶＢＡソースを走らせております。 アウトルックでメールを受信し、受信トレイ入ったメールの本文内にある"昭和"または"平成"のキーワードを読み分けて、某プログラムを走らせるものです。某プログラムはShellで呼び出してから動き始め20秒程度で終了します。ほとんどの場合、一回の受信で、1通しかメールが入りませんが、まれに2通入る事が有ります(同時接続のクライアントは2台なので、同時に送られると2通入りますが、3通以上同時に入る事はありえません） その場合、下記のソースで走らせると、一度に二つのshellが立ち上がってしまい、不具合が生じます（同種同時あるいは異種同時起動ができないプログラム仕様なので） そこで、一つ目の処理が終わってから、二つ目の処理に入る・・・という動きにしたいのですが、見当がつきません。 ご教示をいただけると助かります。宜しくお願いします。 Private Sub Application_NewMail() Const SEARCHWORDA = "昭和" Const SEARCHWORDB = "平成" Dim myNS As NameSpace Dim myInBox As MAPIFolder Dim myItem As MailItem Set myNS = Outlook.Application.GetNamespace("MAPI") Set myInBox = myNS.GetDefaultFolder(olFolderInbox) For Each myItem In myInBox.Items If InStr(myItem.Body, SEARCHWORDA) > 0 Then shell "hoge1.exe" End If If InStr(myItem.Body, SEARCHWORDB) > 0 Then shell "hoge2.exe" End If Next End Sub
- 締切済み
- Visual Basic
- 変数 requestsFolder に格納できない
アウトルックvbaでこれを実行すると Sub test() Dim requestsFolder As MAPIFolder Dim appNameSpace As NameSpace Set appNameSpace = Application.GetNamepace("MAPI") Set requestsFolder = appNameSpace.GetDfaultFolder(olFolderInbox) End Sub 「実行時エラー'438': オブジェクトは、このプロパティまたはメソッドをサポートしていません」 が出るのですが、何がおかしいのでしょうか？まったくわかりません。
- ベストアンサー
- Visual Basic
- Access 重複しないメールをテーブルに取り込む
参考サイトのサンプルをマネしながら少しだけ改造して、OutLookのメールをAccessのテーブル"tbl_mail"に取り込むVBAを書いてみました。 一度取り込んだメールは二度と取り込まない仕組みなのですが、実行してみると必ず1通だけ重複したメールを取り込んでしまいます。 対象フォルダは「個人用フォルダ」の中の「受信トレイ」の中の「集荷」です。 サンプルとして３通のメールを入れていますが、何度実行しても、 "新しいメールはありませんでした。"とはならずに、 "読込み1件・重複2件"となります。 最近ADOを勉強し始めたばかりで原因がさっぱりわかりません。 このサンプルに対する質問は検索してもほとんど見つけられませんでした。 よろしくお願いいたします。 Access2010（Win7）で作り、DBはUSBに保存して、Access2007(vista)でも使っています。 フォームのボタンで標準モジュールのFunction MailGetoを呼び出して実行しています。 Function MailGeto() On Error GoTo エラー Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim myNaSp As NameSpace Dim myFolder As MAPIFolder Dim mySecFolder As MAPIFolder Dim myThrFolder As MAPIFolder Dim myItem As MailItem Dim myindex As Long, x As Long, y As Long, i As Long, r As Long Dim MyCri As String Set cn = Application.CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "tbl_mail", cn, adOpenKeyset, adLockOptimistic Set myNaSp = GetNamespace("MAPI") Set myFolder = myNaSp.GetDefaultFolder(olFolderInbox) i = 0: r = 0 For x = 1 To myFolder.Folders.Count Set mySecFolder = myFolder.Folders(x) For myindex = 1 To mySecFolder.Items.Count Set myItem = mySecFolder.Items(myindex) '受信日時と件名をつなげた文字列を一意とする MyCri = myItem.ReceivedTime & myItem.Subject '条件…"tbl_mail"テーブルの"KEY"フールドの値と一致するもの rs.Find "KEY='" & MyCri & "'" If rs.EOF Then '検索条件と合致する物がない場合 rs.AddNew rs!Key.Value = MyCri rs.Fields("フォルダー").Value = mySecFolder rs.Fields("受信日").Value = myItem.ReceivedTime rs.Fields("送信者").Value = myItem.SenderName rs.Fields("件名").Value = myItem.Subject rs.Fields("メール").Value = myItem.SenderEmailAddress rs.Fields("内容").Value = myItem.Body rs.Update i = i + 1 'メール件数を求めます。 Else r = r + 1 End If Next Next If i = 0 Then MsgBox "新しいメールはありませんでした。" Else MsgBox "メールの更新が完了しました。" & Chr(13) & Chr(13) & _ "・読込み " & i & "件" & Chr(13) & _ "・重複 " & r & "件" End If rs.Close cn.Close Exit Function エラー: If Err.Number = 287 Then MsgBox "書き出しを中止しました" Else MsgBox Err.Number & Err.Description MsgBox "予期せぬエラーが発生しました" End If End Function
- ベストアンサー
- その他(データベース)
お礼
早速のご回答有難うございます。 ActiveExplorerのeが抜けていましたね。 気付きませんでした。 うまくできました。 ご回答ありがとうございました。