質問者
excel マクロ実行中に手動で開いた他のbookを同マクロで認識する方法を教えてください。

質問
-
手動.xlsxを準備して
起動後マクロ実行なら動作するコードを下記します。
マクロ実行後に手動.xlsxを起動しても見つけられません。認識できる方法を探しています。------------------------------------------------------------
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub 手動()
Dim wb As Workbook, flag As Boolean, find1 As String
find1 = "手動"
Sleep 20000
For Each wb In Workbooks
If InStr(wb.Name, find1) > 0 Then
flag = True
Exit For
End If
Next wb
If flag = True Then
MsgBox "手動.xlsx見つけた"
Else
MsgBox "手動.xlsx見つけられない"
End If
End Sub
すべての返信
-
参考になるかどうか分かりませんが、、、、、、、
https://oshiete.goo.ne.jp/qa/5543578.html
「EXCEL VBAで2つEXCELを起動したときのブック名取得の方法」
ここにあった下記ページ
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=63055;id=excel
ここのマクロを訳も分からずいじくっていたら他ブックのブック名を取得できました。
なお、コードの意味も分からずたまたまうまくいっただけですので解説も質問への回答もできません。
熟練者さんたちの回答が出るまでの場つなぎのつもりで上げました。
'------------------------------------------------------------------------------------------
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32.dll" _
(ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IIDFromString Lib "ole32" _
(lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" _
(ByVal lResult As Long, riid As Any, _
ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFCPrivate Const IID_IMdcList = "{8BD21D23-EC42-11CE-9E0D-00AA006002F3}"
Private Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"Private Const WM_GETOBJECT = &H3D&
Type WbkDtl
hWnd As Long
wkb As Excel.Workbook ' 此処にブックのオブジェクトが入る
End Type
Private wD() As WbkDtl
' コールバック関数
Public Function EnumWindowsProc(ByVal hWnd As Long, _
ByVal lParam As Long) As Long
Dim strClassBuff As String * 128
Dim strClass As String
Dim lngRtnCode As Long
Dim lngThreadId As Long
Dim lngProcesID As Long' クラス名取得
lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
If strClass = "XLMAIN" Then
' 子ウィンドウを列挙
lngRtnCode = EnumChildWindows(hWnd, _
AddressOf EnumChildSubProc, lParam)
End If
' 列挙を継続
EnumPass:
EnumWindowsProc = True
End Function' コールバック関数 - 子ウィンドウを列挙
Private Function EnumChildSubProc(ByVal hwndChild As Long, _
ByVal lParam As Long) As Long
Dim strClassBuff As String * 128
Dim strClass As String
Dim strTextBuff As String * 516
Dim strText As String
Dim lngRtnCode As Long
' クラス名取得
lngRtnCode = GetClassName(hwndChild, strClassBuff, Len(strClassBuff))
strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
If strClass = "EXCEL7" Then
' テキストをバッファに
lngRtnCode = GetWindowText(hwndChild, strTextBuff, Len(strTextBuff))
strText = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
If InStr(1, strText, ".xla") = 0 Then '
If Sgn(wD) = 0 Then
ReDim wD(0)
wD(0).hWnd = hwndChild
Else
ReDim Preserve wD(UBound(wD) + 1)
wD(UBound(wD)).hWnd = hwndChild
End If
End If
End If
' 列挙を継続
EnumChildPass:
EnumChildSubProc = True
End FunctionPublic Sub GetExcelBook(wDl As WbkDtl)
Dim IID(0 To 3) As Long
Dim bytID() As Byte
Dim lngResult As Long
Dim lngRtnCode As Long
Dim wbw As Excel.Window
If IsWindow(wDl.hWnd) = 0 Then Exit Sub
lngResult = SendMessage(wDl.hWnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
If lngResult Then
bytID = IID_IDispatch & vbNullChar
IIDFromString bytID(0), IID(0)
lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, wbw)
If Not wbw Is Nothing Then Set wDl.wkb = wbw.Parent
End If
End SubSub 他ブック名取得()
Dim lngRtnCode As Long
Dim i As Long
Dim last As Long
last = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & last).ClearContents
On Error Resume Next 'これが無いとエラーになった
Erase wD
' ワークブックのウィンドウハンドルを取得
lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
If Sgn(wD) <> 0 Then
For i = 0 To UBound(wD)
Call GetExcelBook(wD(i))
Cells(i, 1) = wD(i).wkb.Name
Next
End If
last = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & last).Select
ActiveSheet.Range("$A$1:$A$" & last).RemoveDuplicates Columns:=1, Header:=xlNo
For i = 1 To last
If Right(Cells(i, 1).Value, 4) = "XLAM" Then Cells(i, 1).Value = ""
Next
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:A" & last)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub -
gomen_0 さん、
ご質問の意味を誤解していたらお許しいただきたのですが・・・
ご希望は、マクロで開いたブックではなく、「手動で開いた」ブック(おそらくマクロ実行時に開かれているもの)を取得したい、ということだと思います。
もしそうなら、現在開かれているブック(ファイル名)を取得することはできると思いますが、ブックが開かれた手段(マクロによるのか、手動によるのか)を判断する必要があり、無理なのでは・・・と思います。
それが可能であるなら、私も知りたいです。
北窓舎:芦田- 編集済み Ashidacchi 2017年4月2日 7:01
-
手動OPENEXCLEは説明を簡単にしようとして引用しました。
実際はexcelマクロからIEのWEB上にあるCSVファィルを開けて
そのデータを引っ張ってくるプログラムをつくるのが目的です。
1.IE上のCSVを開けるマクロ
2.CSVからデータを取り込むマクロ
は正常に動作しているのですが
どうしても2つを連動して動作させる事が
できません。それはマクロ実行中に開けた
BOOKがなぜか認識できないからです。
とあまり長々書いても論点ズレるかと
冒頭の質問になっています。 補足:WEB上にCSVファィル張り付ていたらマクロから開ければコントロール可能なのですがCSVは条件入れるとWEBサーバー上でダウンロード可能な形になるのでsendkeysを使用して手動で開けたような状態で開けています。
- 編集済み gomen_0 2017年4月2日 8:43
-
gomen_0 さん、
新規ファイルに CSV データを貼り付け、任意の名前を付けて保存するサンプルを作ってみました。
この動作を実行するのはボタン[Save as New file]です。
保存するファイル名は B1 セルにフルパスで入力しています。
このファイル(ブック)の2番目のシートに CSV データが入っています。
ボタンのコードは次のとおりです。
Private Sub btn_SaveNewFile_Click() ' -- 新規ファイル名(フルパス)の取得(ファイル名は cell [B1] に入力) Dim saveFileName As String saveFileName = Range("SaveFileName").Value ' -- シート "CSV data" をコピー(これだけで新規ブックが作られ、貼り付けられる) Worksheets("CSV data").Copy ' --- 新規ブックを保存 ActiveWorkbook.SaveAs saveFileName ' -- 名前を付けて保存 MsgBox saveFileName & " を保存しました。" End Sub
お役に立てば幸いです。
北窓舎:芦田 -
大変面白いサンプルありがとうございます。
こんなやり方もあるのかと参考になりました。
ただやりたい事をもう少し日本語のフローにします。
現在下記1から13はすでに作成して正常動作しています。
'-------------------------------------
01.マクロ1実行(手動)
02.マクロ1でIE上の指定URLを開ける。
03.マクロ1でファィル出力の条件を指定URLに登録する。
04.マクロ1で指定URL上にある「ファィル出力」を起動する。
05.IEが[開ける(O)、保存する(S),キャンセル(C)]
というポップアップ表示を出す。
06.マクロ1でsenskeysでALT+Oを送る。
07.マクロ1終了
'-------------------------------------
08.ファィルが開く(マクロ1で開けるキーを送ったのでCSVファィル開く)
'-------------------------------------
09.マクロ2実行(08でファィル開いたのを確認して手動で)
10.マクロ2で開いたファィルを認識する。
11.マクロ2で認識したファィルからマクロ2を
実行しているEXCELシート上にデータコピーする。
12.マクロ2でexcel上やりたいデータ処理する。
13.完了
'-------------------------------------
★やりたいことは01~13までを一つのマクロで実行する事。
例えば
07でマクロ1終了せずsleep等で待つ。
08スリープ中にファィル開く事は確認しいます。
09.マクロ1で開いたファィルを認識する。
⇒これができません。これをやる簡単な方法が知りたい。
これをやれる簡単なコードはどうもなさそうです。
かなり複雑な処理なら可能そうですが、、、
以上 -
長々とお付き合いいただきありがとうございます。
これで最後としたいと思います。
まず実コードはイントラ内で動作させているので
そのまま出しても再現実験できません。
問題点を最も再現しているのが質問時のサンプルコードです。
もう少し詳細にサンプルコードでの不具合点を書きます。
「マクロA」を下記とします。
'----------------------------------------------------------
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub 手動()
Dim wb As Workbook, flag As Boolean, find1 As String
find1 = "手動"
'この間に手動で手動excel起動する。
Sleep 20000'約20秒待つ
For Each wb In Workbooks
If InStr(wb.Name, find1) > 0 Then
flag = True
Exit For
End If
Next wb
If flag = True Then
MsgBox "手動.xlsx見つけた"
Else
MsgBox "手動.xlsx見つけられない"
End If
End Sub
'----------------------------------------------------------
①「手動.xlsx」と言う名前のexcel(内容はどうでも良い)を準備
②「test.xlsm」と言う名前でマクロAが記載されているexcelを準備
正常動作フロー
1.②をダブルクリックで開ける。
2.①をダブルクリックで開ける。
3.②のマクロAを実行する。
4.約20秒程度待つ
5."手動.xlsx見つけた"表示BOXがでる。
6.OKでマクロ終了
⇒正常に見つけられているので後は処理するだけ。
不具合動作フロー
1.②をダブルクリックで開ける。
2.②のマクロAを実行する。
3.実行直後に①をダブルクリックで開ける。
(マクロ中に手動で他book起動)
4.約20秒程度待つ間に①は開く。
(PCにより時間かかる物もあるので時間のばぜば開く)
5.約20秒後"手動.xlsx見つけられない"boxが出る。
6.OKでマクロ終了
7.②のマクロAを再度実行する。
(状況的には正常の3.と同じ)
8.約20秒程度待つ
9."手動.xlsx見つけられない"表示BOXがでる。
⇒正常に見つけられないので後の処理ができない。
つまり②のマクロ上では見つけられないWINDOWS上に
①のファィルは開いている。
というのが私の結論です。
感覚的には
□正常時(両方開いた後)は下記のような起動状況と推定しています。
WINDOWS
|
EXCEL------
| |
②BOOK ①BOOK⇒EXCELの下に2つが開いているのでexcelの
コマンドで見つけられる。
□不具合時(マクロ実行中に開く)は下記のような起動状況と推定しています。
WINDOWS---
| |
EXCEL1 EXCEL2
| |
②BOOK ①BOOK⇒WINDOWSの下に2つのexcelが開いている。
WINDOWS APIでないと見つけられない。
①ファィルをWINDOWS APIから見つけようとしているのが
TETUOさんの回答いただいているコマンド群だと推定しています。
②を閉じて再起動してマクロAを実行すれば①は見つけられます。
つまりはexcelにリフレッシュやリセットのようなコマンドがあれば
動作しそううな気がしたのでどなたかご存知ないかと質問してみました。
あっちこっちWEBで検索したのですがいっこうに答えが見つからず
あきらめの境地になってきました。
追記
マクロ上で一旦ローカルPCへSAVEすれば
どこにファィルあるのかわかるので同マクロ上で
処理は可能、つまり1つのマクロで処理はできそうです。
SAVEしたくないのでどうにか空中(開くのみ)で
どうにかならないかと模索していました。
最終的には一旦ローカルにSAVEするのが
一番手っ取り早そうです。以上
- 編集済み gomen_0 2017年4月4日 12:46
-
gomen_0 さん、
おはようございます。
発想を変えていただき、ローカル/ファイルサーバーのテンポラリフォルダーに一旦保存なさるのが簡単でよいかと思います。
私的見解ですが、昨今はハードウェア資源が潤沢になっています。ストレージでいえば、大容量・廉価になっています。コンピュータ全体としてのスループットも通常用途には十分だと思います。高いのは人件費、人間の労働コスト・・・
なので、ハードウェアリソースは気にせず、ソースコードの可読性やメンテナンスの容易性、実行場面での運用コストの低減を優先するのが良いのかなぁと思っています。
すでにリタイアした還暦もすぎた老人ですが、そう思います。
成功をお祈りしております。
北窓舎:芦田