プロが教える店舗&オフィスのセキュリティ対策術

VBAで二重起動を防止したいのですが、
いろいろ調べましたが、わかりませんでした。
なにかいい方法はないでしょうか?

EXCELで見積書を作成して、そのファイルをVBAで保存するとき、ついでに、Outlook予定表に見積り期限日予定を入れるものです。

ファイル保存コード省略 Flnm=パス

'ここからアウトルック操作
Dim oApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim objITEM As Object



'outlook 起動
Set oApp = CreateObject("Outlook.Application") '既に起動してても新規起動

Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(9) '起動時フォルダーを指定
myFolder.Display

'アイテムの作成
Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
objITEM.Display '編集画面を表示

'予定表内容
objITEM.Subject = "見積り発行後のフォロー" '件名
objITEM.body = "見積り発行から3ヶ月経ちました" '本文
objITEM.Attachments.Add Flnm 'ファイルの添付
objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間
objITEM.Save '保存
objITEM.Close 2 '閉じる

EXCEL2007とOutlook2007を使用しています。
1.多重起動しないことと
2.起動中で最小化されたOutlookがあるならアクティブ化して予定を入れる、または
3.起動していなかったら起動させて、予定を入れる
と云うことがやりたいのですが・・・

教えて!goo グレード

A 回答 (4件)

#3さんのご指摘の件ですが、おそらく、Outlook の「マルチユース(Multi-Use)」のことを指しているかとは思います。

それ自体では、確かに、Outlookは、「マルチユース」ですから、二重起動はしないです。 CreateObject("Outlook.Application") で、オートメーション・オブジェクトを作るなら、二重起動はしませんが、その後、MAPIで名前空間を作り、「予定表」を表示しています。だから、そのマクロを繰り返せば、「予定表」が二重に起動します。

だから、#2のコードは、既に起動している場合は、単に前面に出すだけのものです。
それ以上に、今のところ、オブジェクトを再取得する方法については、詳しく検証していませんが、

Else
'...
  Set objWShell = Nothing '←ここで終わった後に、
  Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
  objITEM.Display 'とすればよいはずです。
End If

なお、コマンドボタンなどに、マクロを登録してください。モジュールから直接行っても、Outlook の予定表は前面には出せません。

この回答への補足

なんどもすみません。
やはり予定表を自動入力するというところがうまくいきません。
ただし、Outlookが起動していなければ、成功します。

既に起動中のものに予定を入れることが出来ません。

Outlookからデータを取得する例はたくさん検索されますが
その逆はとても少なく難儀します。

もしよろしければもう少しお付き合い下さい。

補足日時:2010/08/03 10:16
    • good
    • 0
この回答へのお礼

ここの文を

'予定表内容
  objITEM.Subject = "見積り発行後のフォロー" '件名
  objITEM.body = "見積り発行から3ヶ月経ちました" '本文
  objITEM.Attachments.Add Flnm 'ファイルの添付
  objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間
  objITEM.Save '保存
  objITEM.Close 2 '閉じる

このようにすることで、

 Else
  Set objWShell = CreateObject("WScript.Shell")
  objWShell.AppActivate oApp.ActiveWindow.Caption 'アクティブ化
  hwnd = FindWindow(FCLASSNAME, vbNullString)
  SetForegroundWindow hwnd '前面に持ってきて
  objWShell.SendKeys "% X" '最大化
  Set objWShell = Nothing
 End If

'予定表内容
  objITEM.Subject = "見積り発行後のフォロー" '件名
  objITEM.body = "見積り発行から3ヶ月経ちました" '本文
  objITEM.Attachments.Add Flnm 'ファイルの添付
  objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間
  objITEM.Save '保存
  objITEM.Close 2 '閉じる

すべて解決しました。
順番が違っていただけでした。

大変お騒がせしましたが、無事目的達成できました。
ありがとうございました。

お礼日時:2010/08/03 11:10

Outlook は基本的に多重起動はしません。



Set oApp = CreateObject("Outlook.Application") '既に起動してても新規起動

とありますが、本来であれば上記の記述はすでに起動している場合はその Outlook を使用するという動作になります。
そうならないのだとすると、何らかの理由で Outlook が正常に終了できておらず、起動中の Outlook が使用できないので、新たに Outlook が起動されてしまうのだと考えられます。
たいていはアドインが問題ですので、アドインをアンインストールして試してみてください。
    • good
    • 0
この回答へのお礼

ありがとうございます。
アドインが問題になる場合があるのですね。

対策してみます。

お礼日時:2010/08/03 10:07

>1.多重起動しないことと


>2.起動中で最小化されたOutlookがあるならアクティブ化して{?予定を入れる、または}
>3.起動していなかったら起動させて、予定を入れる

一部を除いて、3つの要件は満たしているはずです。予定を入れるというのは、すでに行っているのではないでしょうか。だから、最小化されたOutlook は、既に処理されていると解釈しています。


'//
Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub OutLookCheckers1()
 Dim oApp As Object 'Outlook.Application
 Dim myNameSpace As Object 'Outlook.Namespace
 Dim myFolder As Object 'MAPIFolder
 Dim objITEM As Object
 Dim objWShell As Object
 Dim Flnm As Variant
 Dim flg As Boolean
 
 Dim hwnd As Long
 Dim strClassName As String * 100
 Dim tmpClassName As String
 Const FCLASSNAME As String = "rctrl_renwnd32" 'クラス名
 'Outlook 起動
 On Error Resume Next
 Set oApp = GetObject(, "Outlook.Application") '既に起動している場合に取得
 If Err.Number <> 0 Then
  Set oApp = CreateObject("Outlook.Application")
  flg = True
 End If
 On Error GoTo 0
 If flg Then
  Set myNameSpace = oApp.GetNamespace("MAPI")
  Set myFolder = myNameSpace.GetDefaultFolder(9) '起動時フォルダーを指定
  myFolder.Display
  Set objITEM = oApp.CreateItem(1) '予定表作成画面を指定
  objITEM.Display '編集画面を表示
 'アイテムの作成 (ここは試していない)
 ' '予定表内容
 ' objITEM.Subject = "見積り発行後のフォロー" '件名
 ' objITEM.body = "見積り発行から3ヶ月経ちました" '本文
 ' objITEM.Attachments.Add Flnm 'ファイルの添付
 ' objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間
 ' objITEM.Save '保存
 ' objITEM.Close 2 '閉じる
 Else
  Set objWShell = CreateObject("WScript.Shell")
  objWShell.AppActivate oApp.ActiveWindow.Caption 'アクティブ化
  hwnd = FindWindow(FCLASSNAME, vbNullString)
  SetForegroundWindow hwnd '前面に持ってきて
  objWShell.SendKeys "% X" '最大化
  Set objWShell = Nothing
 End If
 
 Set oApp = Nothing
End Sub

この回答への補足

ありがとうございます。
Outlookが起動していない際には、予定表、下記部分は成功しました。
' '予定表内容
 ' objITEM.Subject = "見積り発行後のフォロー" '件名
 ' objITEM.body = "見積り発行から3ヶ月経ちました" '本文
 ' objITEM.Attachments.Add Flnm 'ファイルの添付
 ' objITEM.Start = DateAdd("m", 3, Date) & " 8:30" '予定日と開始時間
 ' objITEM.Save '保存
 ' objITEM.Close 2 '閉じる
ただ、既にOutlookが起動していた場合は、予定が入らないまたは件名が「X」となってしまっています。
予定を差し込むのがうまくいかないみたいです・・・

補足日時:2010/08/03 10:03
    • good
    • 0
この回答へのお礼

大変参考になりました。
丸写しではなく、なるべく自分で記述できるように頑張ります!

お礼日時:2010/08/03 11:13

多重起動するのは、OutLook自体を閉じないからです。



oApp.Quit

を、コードの最後の方に入れた方がいいです。

この回答への補足

ありがとうございます。
ただ、oApp.Quitだともともと最小化していたOutlookまで終了してしまいます。

さらに検討してみます。

補足日時:2010/08/03 09:47
    • good
    • 0
この回答へのお礼

ありがとうございました。
無事解決しました!

お礼日時:2010/08/03 11:13

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング