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

  • 質問

  • 手動.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

    2017年4月1日 14:07

すべての返信

  • 参考になるかどうか分かりませんが、、、、、、、
    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 = &HFFFFFFFC

     Private 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 Function

     Public 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 Sub

        Sub 他ブック名取得()
        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

    2017年4月2日 0:59
  • 返信ありがとうございます。

    WIN APIに戻らないと判別はできないと思っていますが

    かなり複雑なのでもっと簡単な方法があるはずと思って質問しました。

    workbooksのリフレッシュやBOOKが起動した時のような状況再現が

    リセット等の簡単なコマンドとしてないかと思いまして、、、、

    WEB上色々探したのですが記述なく質問しています。

    やはりなかなか難しそうですね。


    • 編集済み gomen_0 2017年4月2日 8:48
    2017年4月2日 2:19
  • gomen_0 さん、

    ご質問の意味を誤解していたらお許しいただきたのですが・・・

    ご希望は、マクロで開いたブックではなく、「手動で開いた」ブック(おそらくマクロ実行時に開かれているもの)を取得したい、ということだと思います。

    もしそうなら、現在開かれているブック(ファイル名)を取得することはできると思いますが、ブックが開かれた手段(マクロによるのか、手動によるのか)を判断する必要があり、無理なのでは・・・と思います。

    それが可能であるなら、私も知りたいです。

    北窓舎:芦田
    2017年4月2日 7:00
  • 手動OPENEXCLEは説明を簡単にしようとして引用しました。
    実際はexcelマクロからIEのWEB上にあるCSVファィルを開けて
    そのデータを引っ張ってくるプログラムをつくるのが目的です。
    1.IE上のCSVを開けるマクロ
    2.CSVからデータを取り込むマクロ
    は正常に動作しているのですが
    どうしても2つを連動して動作させる事が
    できません。それはマクロ実行中に開けた
    BOOKがなぜか認識できないからです。
    とあまり長々書いても論点ズレるかと
    冒頭の質問になっています。

    補足:WEB上にCSVファィル張り付ていたらマクロから開ければコントロール可能なのですがCSVは条件入れるとWEBサーバー上でダウンロード可能な形になるのでsendkeysを使用して手動で開けたような状態で開けています。

    • 編集済み gomen_0 2017年4月2日 8:43
    2017年4月2日 8:35
  • 2.CSVからデータを取り込むマクロ
    は正常に動作しているのですが
    CSV からデータを取り込むマクロはOKとのことですが、
    CSV データを「どこに」取り込んでいるのですか?
    また、最終的には CSV データを Excel シートに取り込むのではないのですか?

    手動で他のブックを開く、というのはマクロでExcel ブックを開く、という意味なのですよね?


    2017年4月2日 8:45
  • CSV データをマクロが動作しているexcel上に取り込んでいます。

    マクロで開いていますが補足で書いた通りsendkeysでALT+Oを送ってキー操作で開けています。

    WEB上にCSVの実体があれば直接開くこと可能なのですが、、、、

    「ファィル出力」と言うボタンしかありません。


    2017年4月2日 9:02
  • 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
    お役に立てば幸いです。

    北窓舎:芦田
    2017年4月3日 4:13
  • 大変面白いサンプルありがとうございます。
    こんなやり方もあるのかと参考になりました。
    ただやりたい事をもう少し日本語のフローにします。
    現在下記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で開いたファィルを認識する。
     ⇒これができません。これをやる簡単な方法が知りたい。

    これをやれる簡単なコードはどうもなさそうです。
    かなり複雑な処理なら可能そうですが、、、
     
    以上
    2017年4月3日 13:50
  • gomen_0 さん、

    私が提示したサンプルでは、CSV データを貼り付けた新しいブックに名前を付けて保存しています。名前を指定して保存しているのですから、ファイル名が分からないということはありません。
    つまり、8の部分でサンプルのような処理を行えば、9以降は連続して実行できると思います。

    ご質問の意味を誤解しているのかも知れませんが、1~12を連続して行うことは簡単だと思います。サンプルの処理を利用しても連続実行ができないのなら、VBA ソースを開示してくださるようお願いいたします。

    北窓舎:芦田
    2017年4月4日 0:58
  • 長々とお付き合いいただきありがとうございます。
    これで最後としたいと思います。
    まず実コードはイントラ内で動作させているので
    そのまま出しても再現実験できません。
    問題点を最も再現しているのが質問時のサンプルコードです。
    もう少し詳細にサンプルコードでの不具合点を書きます。
    「マクロ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
    2017年4月4日 11:48
  • gomen_0 さん、

    おはようございます。
    発想を変えていただき、ローカル/ファイルサーバーのテンポラリフォルダーに一旦保存なさるのが簡単でよいかと思います。

    私的見解ですが、昨今はハードウェア資源が潤沢になっています。ストレージでいえば、大容量・廉価になっています。コンピュータ全体としてのスループットも通常用途には十分だと思います。高いのは人件費、人間の労働コスト・・・
    なので、ハードウェアリソースは気にせず、ソースコードの可読性やメンテナンスの容易性、実行場面での運用コストの低減を優先するのが良いのかなぁと思っています。

    すでにリタイアした還暦もすぎた老人ですが、そう思います。
    成功をお祈りしております。
    北窓舎:芦田

    2017年4月4日 21:50