在宅ワークのリアルをベテランとビギナーにインタビュー>>

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.起動していなかったら起動させて、予定を入れる
と云うことがやりたいのですが・・・

このQ&Aに関連する最新のQ&A

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に関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qアウトルックが起動しているかどうかを取得するには?

http://www.ken3.org/cgi-bin/group/vba_outlook.asp
を参考に
Sub Sample()
Dim oApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder

'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")

'作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display)
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定
myFolder.display
End Sub
でエクセルからアウトルックを起動しているのですが
既に起動していると2個起動してしまいます。

「既に起動しているのなら起動しない」という事はできますか?

参考URLに
起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を
と書いてありますが、ちょっと勘弁できませんでした笑

http://www.ken3.org/cgi-bin/group/vba_outlook.asp
を参考に
Sub Sample()
Dim oApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder

'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")

'作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display)
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定...続きを読む

Aベストアンサー

No.2です。
少し変更しました。
質問者様のご希望は、Outlookのフォルダのウィンドウがあれば新たに開かない、というものと思いますのでそのようにしました。
(No.2のコードでは受信トレイ以外のフォルダが開いていると、新たに受信トレイのウィンドウが開いてしまいます。)

Sub Sample2()
Dim oApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder

'outlook 起動をCreateObjectで ※フォルダのウィンドウがあるなら一応開かないようになった
Set oApp = CreateObject("Outlook.Application")
'参照設定済みのようなので Set oApp = New Outlook.Application でもいいかも

Set myNameSpace = oApp.GetNamespace("MAPI")

'outlookのフォルダのウィンドウがすでに存在するならそのうちの1つをmyFolderにSetし、
'なければ規定のフォルダを得る。
If oApp.Explorers.Count > 0 then
Set myFolder = oApp.Explorers.Item(1).CurrentFolder.FolderPath
Else
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定
End If

myFolder.display
End Sub

なお、No.1様解説のGetObjectでうまくいくならばその方が私の回答よりも良いと思います。

No.2です。
少し変更しました。
質問者様のご希望は、Outlookのフォルダのウィンドウがあれば新たに開かない、というものと思いますのでそのようにしました。
(No.2のコードでは受信トレイ以外のフォルダが開いていると、新たに受信トレイのウィンドウが開いてしまいます。)

Sub Sample2()
Dim oApp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder

'outlook 起動をCreateObjectで ※フォルダのウィンドウがあるなら一応開かないようになった
Set oApp = CreateO...続きを読む

QEXCELのマクロの重複起動の禁止

6時間くらい動作するEXCEL2000のマクロ作ったのですが、間違えて重複起動をしてしまうことがあります。
次のような対応策を考えてみたのですが、マクロの作り方がわかりません。

(1)マクロの起動時に、マクロ内で現在動作しているマクロと重複チェックを行い、現在動作しているマクロを終了し、新たにマクロを開始する方法
(2)マクロの起動時に、マクロ内で現在動作しているマクロと重複チェックを行い、エラーメッセージを出力する方法
(3)現在稼動しているマクロを表示確認できる方法

他の方法でも結構ですので、マクロをご教示ください。
よろしくお願いします。

Aベストアンサー

こんにちは。(2)の方法ですが、

1. プライベート変数myFlagを宣言
2. マクロの実行時に myFlag の値を調べる
  2-1. False なら myFlagにTrueをセットし、以降のマクロを実行する
  2-2. True ならマクロ実行中なので、処理中止
3. 一応、全ての処理の最後に、 myFlag = True としておく

のような処理になるかと思います。具体的には、

Private myFlag As Boolean

Sub TEST()

  If myFlag Then
    MsgBox "既に実行中です..."
    Exit Sub
  End If

  'myFlag=Falseなら以降を実行
  myFlag = True

  '(略)これ以降に処理を書く

  '処理の最後に一応
  myFlag = False

End Sub

こんな感じでしょうか。
あとは、6時間も稼動しているわけですから、プログレスバーでもなんでもよいので進捗状況を表示した方がよいでしょうね。

はずしていたら、すみません。

こんにちは。(2)の方法ですが、

1. プライベート変数myFlagを宣言
2. マクロの実行時に myFlag の値を調べる
  2-1. False なら myFlagにTrueをセットし、以降のマクロを実行する
  2-2. True ならマクロ実行中なので、処理中止
3. 一応、全ての処理の最後に、 myFlag = True としておく

のような処理になるかと思います。具体的には、

Private myFlag As Boolean

Sub TEST()

  If myFlag Then
    MsgBox "既に実行中です..."
    Exit Sub
  End If

  'myFlag...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qエクセルの二重起動をやめたい

VBからエクセルを起動する際、すでに開いているファイルは開かないようにしたく、検索をした結果
http://oshiete1.goo.ne.jp/kotaeru.php3?q=237618
の回答があり参考にしたのですが、うまくいきません。
はじめは
  Dim xlsApp As Excel.Application
  Dim xlsBook As Excel.Workbook
がうまくいかず悩んだのですが、「オブジェクト」-「参照設定」でエクセルを選択することによって解決しましたが、
  For Each xlsBook In xlsApp.Workbooks
    '見つかったらループを抜ける
    If StrComp(xlsBook.FullName, findBookPath, vbTextCompare) = 0 Then
    Exit For
   End If
  Next xlsBook
の部分で上手く引っ掛けることができません。
なにか設定が足りないのか?
どなたか分かる方がみえましたらよろしくお願いいたします。
では

VBからエクセルを起動する際、すでに開いているファイルは開かないようにしたく、検索をした結果
http://oshiete1.goo.ne.jp/kotaeru.php3?q=237618
の回答があり参考にしたのですが、うまくいきません。
はじめは
  Dim xlsApp As Excel.Application
  Dim xlsBook As Excel.Workbook
がうまくいかず悩んだのですが、「オブジェクト」-「参照設定」でエクセルを選択することによって解決しましたが、
  For Each xlsBook In xlsApp.Workbooks
    '見つかったらループを抜ける
    I...続きを読む

Aベストアンサー

Excel.Applicationはクラス名(?)です。

Set xlsApp = GetObject(, "Excel.Application")

第2引数になるのでこのようにしたらどうでしょう?

Q【Excel VBA】マクロでExcel自体を終了させたい

環境:WindowsXP、Excel2003

マクロでエクセルを終了(ブックを閉じて、アプリケーション自体も終了)させたいのですが、以下のコードではアプリケーションが閉じてくれません。

ThisWorkbook.Close
ExcObj.Quit
Application.Quit

どこか悪いところはありますでしょうか?

よろしくお願いします。

Aベストアンサー

普通に考えれば質問者のコードで上手くいきそうですが
hana-hana3さんの回答にもあるようにThisWorkBook.Closeでコード終了となりますので
Application.QuitをThisWorkBook.Closeの前にもってこないといけません。
Application.Quitはそれがあるプロシージャのコードが全て終わるまで
その実行を保留するちょと特別動作をします。

'-------------------------------------
 Application.Quit
 ThisWorkbook.Close
'-------------------------------------
 
 

Qファイルの2重に開いた場合の処理(エクセルVBA)

FileSearchを使って複数のエクセルファイルを順に開きシート内容の更新を行っています。更新すべきファイルは、LAN上のサーバ(LANハードディスク)内のフォルダにおいてありますが、複数の人がファイルを開いて作業を行います。その時、FileSearchで更新作業をしようとすると2重に開く現象が発生します。
ファイルを開く方法は、openメゾッドをworbooksコレクションに対して行っています。
Workbooks.Open Filename:=.FoundFiles(iCount), UpdateLinks:=0で開き、Workbooks(FlieName).Close SaveChanges:=Trueで閉じます。
しかしこのままですと、読み取り専用でファイルを開いてしまい、保存時にコピーを保存するでマクロが止まります。そこで、openメゾッドに、Notify:=Falseを着けると、「読み取り専用で開きますか?」で停止します。次に、On Error GoTo でトラップしようとすると、、「読み取り専用で開きますか?」のダイアログで、いいえを選択するとトラップが出来るのですが、ハイだと当然トラップできません。それよりも、ダイアログが表示されるのには変わりありません。
Displayalerts=Falseとすると、ダイアログは表示されなくなりますが、エラーがトラップ出来なくなります。ファイルの2重で開くのトラップってどうすれば出来るのでしょうか?似たようなものにOpenステートメントもあるようですが、うまく出来ませんでした。どなたか?詳しい方教えて頂けませんでしょうか?宜しくお願い致します。
目的としては、2重に開く現象となったファイル名をThisworkbookのシートに一覧保存してあとで対象のものだけ処理を行うようにしたいです。また、2重に開いたときに表示される使用者名もゲットしたいです。
宜しくお願い致します。

FileSearchを使って複数のエクセルファイルを順に開きシート内容の更新を行っています。更新すべきファイルは、LAN上のサーバ(LANハードディスク)内のフォルダにおいてありますが、複数の人がファイルを開いて作業を行います。その時、FileSearchで更新作業をしようとすると2重に開く現象が発生します。
ファイルを開く方法は、openメゾッドをworbooksコレクションに対して行っています。
Workbooks.Open Filename:=.FoundFiles(iCount), UpdateLinks:=0で開き、Workbooks(FlieName).Close SaveChanges:=True...続きを読む

Aベストアンサー

補足です。#1 の参考URLを参考に関数を書きましたが、

Open strFULLPATH For Binary Access Write As #n

ではなくて、

Open strFULLPATH For Binary Lock Write As #n

とした方が今回の目的にはよりマッチしていると思います。

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QエクセルVBAでOutlookメール作成

いろいろ検索や質問をしてエクセルVBAで、下記のコードによりOutlookのメールを自動作成できるようになりました。

Sub TEST01()
Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
strMOJI = "こんにちは!" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。"
objMAIL.To = "XXXX@XXXXX.co.jp" '宛先
objMAIL.Subject = "テスト" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.display '表示
End Sub

それで、実際にはstrMOJI に代入した文字列の下に、このマクロを記述してあるBOOKのSheets("Sheet1").Range("A1:D10")をコピーし、
「リッチテキスト形式」で貼り付けたいのです。
どのようなコードに変えればよいのか教えていただけると助かります。
よろしくお願いいたします。

いろいろ検索や質問をしてエクセルVBAで、下記のコードによりOutlookのメールを自動作成できるようになりました。

Sub TEST01()
Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
strMOJI = "こんにちは!" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。"
objMAIL.To = "XXXX@XXXXX.co.jp" '宛先
objMAIL.Subject = "テスト" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.display '表示
End S...続きを読む

Aベストアンサー

>ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。
>これは解消できますか?
それは前回QAで手当て済みだったんですけどね。

Dim oApp    As Object
Dim objMAIL  As Object
Dim strMOJI(1) As String
Dim n     As Long

On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
  Set oApp = CreateObject("Outlook.Application")
  oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
End If

Set objMAIL = oApp.CreateItem(0)
strMOJI(0) = "こんにちは!" & vbCrLf & _
       "テストメールです。" & vbCrLf & _
       "よろしくおねがいします。" & vbCrLf
strMOJI(1) = "以上です。" & vbCrLf & _
       "EMAX株式会社" & vbCrLf & _
       "Emax"
objMAIL.To = "E-Mail_Address_Here"
objMAIL.Subject = "テスト"
objMAIL.BodyFormat = 2 'HTML形式
objMAIL.Body = strMOJI(0) & strMOJI(1)
objMAIL.display

n = Len(strMOJI(0))
ActiveSheet.Range("A1:D10").Copy
oApp.ActiveInspector.WordEditor.Range(n, n).Paste
Application.CutCopyMode = False

Set objMAIL = Nothing
Set oApp = Nothing

BodyFormatはHTML形式じゃないと書式が維持できないような感じです。
#バージョン、もしくは受信側のメーラーによるかもしれませんけど..

>ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。
>これは解消できますか?
それは前回QAで手当て済みだったんですけどね。

Dim oApp    As Object
Dim objMAIL  As Object
Dim strMOJI(1) As String
Dim n     As Long

On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
  Set oApp = CreateObject("Outlook.Application")
  oApp.GetNamespace("MAPI").GetDefaultFolder(6).display
End If

...続きを読む


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

人気Q&Aランキング