★★Access2000VBA・Excel2000VBA独学～Win32API。Shell関数で実行したコマンドラインの命令を待機する～その他関連事項も

★★Access2000VBA・Excel2000VBA独学～Win32API。Shell関数で実行したコマンドラインの命令を待機する～その他関連事項も
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
目次

※Shift＋TABキー、もしくは、Homeキー、Homeキー＋TAB数回、を押すと、目次付近に戻れます。
　　
　　
★ Shell関数で、別のプログラムやバッチファイル、コマンドプロンプトのコマンドラインを実行する方法

Accessから他のアプリケーションのファイルを開く方法

公式 Call Shell("アプリ本体のパス",1)

ファイルを直接開きたいときは、プログラム本体のパスのあとに半角空けてから
開きたいファイルのフルパスを記述する。

以下の例は、 C:\dfsr01ハガキ告知面タテ.doc を開く。

≪例1≫
Call Shell("C:\Program Files\Office2000\Office\Winword.exe C:\dfsr01ハガキ告知面タテ.doc", 1)

≪フォルダを開く≫
Call Shell("C:\WINNT\explorer.exe D:\f01\testFolder", 1)
Call Shell("explorer D:\f01\testFolder", 1)

≪DOSプログラムを直接実行させる場合≫
Call Shell("xcopy c:\order01 d:\order01 /s /e /d /y", 1)

shall "cmd /C del D:\3\*.txt /s", 2）
↑↓すべてのサブフォルダについても「txt」拡張子のファイルを全部消す。
Call Shall（"cmd /C del D:\3\*.txt /s", 2）

Dim s_FoldPath As String
Dim s_Cmd01 As String
s_FoldPath = "D:\3"
s_Cmd01 = "cmd /C DEL """ & s_FoldPath & "\*.txt"" /s "
Call Shell(s_Cmd01 ,2)

≪DOSのバッチファイルを実行させる場合≫
Dim RetVal
RetVal = Shell("C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ\Data\databack.bat", 1) ' databack.batを実行します。

≪その他≫
Call Shell("""C:\Program Files\Mojosoft\Rockm\Rockm.exe"" ""C:\My Documents\Roc\画像回転と画像コピー.roc""", 1)
Call Shell("C:\Program Files\Internet Explorer\Iexplore.exe C:\order01\index.htm", 1)

★バッチファイルやコマンドラインを実行中に待機する方法

バッチファイルやコマンドプロンプトのコマンドは、基本的に「非同期」のようなので、VBAで実行すると今の命令が終わらないうちに、次の命令が始まってしまいます。
それを回避するためには「同期処理」をしないといけないのですが、そのほかに「待機する」という方法もあります。
こちらのほうが危険度が少ないような場合はこちらを使ったほうが無難なようです。

'
'
Option Compare Database
Option Explicit

'********************************************************************************
'WindowsAPI宣言
'OpenProcess関数
'プログラム実行状態の監視を開始させる関数
'GetExitCodeProcess関数
'プログラムが終了したか調査する関数
'CloseHandle関数
'プログラム実行状態の監視を終了させる為の関数
'********************************************************************************
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwAccess As Long, ByVal lpCommandLine As Long, ByVal IDProcess As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal lpdExitCode As Long, hHandle As Long) As Long
Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103



Public Function WaitShell(CommandLine As String)
    Dim ShellReturn As Long
    Dim ShellStatus As Long
    Dim ProcessReturn As Long
    Dim ProcessStatus As Long
    'Shell関数を実行する
    ShellReturn = Shell(CommandLine, 2) '第2引数が1だとウィンドウを表示、2はステータスバー。ファイルですか？フォルダですか？と聞かれることもあるので、vbHideにはしないほうがいい。
    'プログラム実行状態の監視を開始
    ProcessReturn = OpenProcess(PROCESS_QUERY_INFORMATION, False, ShellReturn)
    Do
        'プログラムが終了しているか調査
        GetExitCodeProcess ProcessReturn, ShellStatus
        DoEvents
    'プログラムが実行されている間はループしつづける
    Loop While ShellStatus = STILL_ACTIVE
    'プログラム実行状態の監視を終了
    ProcessStatus = CloseHandle(ProcessReturn)
End Function




以上をコピペして実行時は以下のようにする。



Function file_copy01()

    DoCmd.OpenForm "しばらくお待ちください"
    Forms![しばらくお待ちください].Repaint

    Call WaitShell("D:\バックアップ.bat") 'バッチファイルを実行。
    
    DoCmd.Close acForm, "しばらくお待ちください", acSaveYes
    
End Function


'
'

Option Compare Database

Option Explicit

'********************************************************************************

'WindowsAPI宣言

'OpenProcess関数

'プログラム実行状態の監視を開始させる関数

'GetExitCodeProcess関数

'プログラムが終了したか調査する関数

'CloseHandle関数

'プログラム実行状態の監視を終了させる為の関数

'********************************************************************************

Declare Function OpenProcess Lib "kernel32" _

(ByVal dwAccess As Long, ByVal lpCommandLine As Long, ByVal IDProcess As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal lpdExitCode As Long, hHandle As Long) As Long

Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400

Public Const STILL_ACTIVE = &H103

Public Function WaitShell(CommandLine As String)

Dim ShellReturn As Long

Dim ShellStatus As Long

Dim ProcessReturn As Long

Dim ProcessStatus As Long

'Shell関数を実行する

ShellReturn = Shell(CommandLine, 2) '第2引数が1だとウィンドウを表示、2はステータスバー。ファイルですか？フォルダですか？と聞かれることもあるので、vbHideにはしないほうがいい。

'プログラム実行状態の監視を開始

ProcessReturn = OpenProcess(PROCESS_QUERY_INFORMATION, False, ShellReturn)

'プログラムが終了しているか調査

GetExitCodeProcess ProcessReturn, ShellStatus

DoEvents

'プログラムが実行されている間はループしつづける

Loop While ShellStatus = STILL_ACTIVE

'プログラム実行状態の監視を終了

ProcessStatus = CloseHandle(ProcessReturn)

End Function

以上をコピペして実行時は以下のようにする。

Function file_copy01()

DoCmd.OpenForm "しばらくお待ちください"

Forms![しばらくお待ちください].Repaint

Call WaitShell("D:\バックアップ.bat") 'バッチファイルを実行。

DoCmd.Close acForm, "しばらくお待ちください", acSaveYes

End Function

※↓バッチファイルの起動だけでなく、バッチのプログラムを直接指定しても良い。

以下、例。

'
'

Public Function WaitShell(CommandLine As String, sw01 As Integer)
    Dim ShellReturn As Long
    Dim ShellStatus As Long
    Dim ProcessReturn As Long
    Dim ProcessStatus As Long
    'Shell関数を実行する
    ShellReturn = Shell(CommandLine, sw01) '第2引数が1だとウィンドウを表示、2はステータスバー。ファイルですか？フォルダですか？と聞かれることもあるので、vbHideにはしないほうがいい。
    'プログラム実行状態の監視を開始
    ProcessReturn = OpenProcess(PROCESS_QUERY_INFORMATION, False, ShellReturn)
    Do
        'プログラムが終了しているか調査
        GetExitCodeProcess ProcessReturn, ShellStatus
        DoEvents
    'プログラムが実行されている間はループしつづける
    Loop While ShellStatus = STILL_ACTIVE
    'プログラム実行状態の監視を終了
    ProcessStatus = CloseHandle(ProcessReturn)
End Function



Sub CopyTest()

    DoCmd.OpenForm "しばらくお待ちください"
    Forms("しばらくお待ちください").Repaint
    Call WaitShell("xcopy c:\order01\A.txt d:\order01\B.txt /s /e /d /y", 2)
    DoCmd.Close acForm, "しばらくお待ちください"

End Sub

'
'

Public Function WaitShell(CommandLine As String, sw01 As Integer)

Dim ShellReturn As Long

Dim ShellStatus As Long

Dim ProcessReturn As Long

Dim ProcessStatus As Long

'Shell関数を実行する

ShellReturn = Shell(CommandLine, sw01) '第2引数が1だとウィンドウを表示、2はステータスバー。ファイルですか？フォルダですか？と聞かれることもあるので、vbHideにはしないほうがいい。

'プログラム実行状態の監視を開始

ProcessReturn = OpenProcess(PROCESS_QUERY_INFORMATION, False, ShellReturn)

'プログラムが終了しているか調査

GetExitCodeProcess ProcessReturn, ShellStatus

DoEvents

'プログラムが実行されている間はループしつづける

Loop While ShellStatus = STILL_ACTIVE

'プログラム実行状態の監視を終了

ProcessStatus = CloseHandle(ProcessReturn)

End Function

Sub CopyTest()

DoCmd.OpenForm "しばらくお待ちください"

Forms("しばらくお待ちください").Repaint

Call WaitShell("xcopy c:\order01\A.txt d:\order01\B.txt /s /e /d /y", 2)

DoCmd.Close acForm, "しばらくお待ちください"

End Sub

　　
　　
★ 「超危険！！」WshShellクラスで「非同期」を「同期」でバッチ処理する

VBAでバッチファイル（bat）を非同期／同期で実行する
にあるように、簡単にできるように書いて歩けれど、とてつもない落とし穴がありました。

バッチ実行の場合はわからないんけど、コマンドラインの実行、例えば、コマンドプロンプトの「DEL」を、WshShellにて、「サブフォルダも＝/s」で実行すると、指定した以外のファイル、例えば上の階層のファイルが、画面に表示されたメッセージの意味がわからずに誤操作で全部消えてしまいました。
僕の場合は、「txtファイルだけ消して」と指定したにもかかわらず、その他の拡張子のファイルも全部消えました。（上の階層のファイルが。）
これは慎重に対処する必要があります。
多分、自分が未熟なのが原因。でも、とてもわかりにくい。安易に使わないほうが無難です。
使うならしっかりと動作の特性を学んでおかないといけないです。

WshShellクラスを使う時は必ずバックアップを「外部記憶媒体」に作って、その中でテストする必要があります。
特に「DEL」コマンドなどの危険なコマンドのテストは。
（DELなどで削除すると、ゴミ箱にも入らないため、復元が非常に難しくなるので。）

APIやWaitで「待機」する場合は、そのような心配はありません。

★ 複数のmdbを立て続けに、実行を待機しながら、１つ１つ終了を待ちながら実行する方法

以下の内容の「Command1_Click()」のようなコードを実行。

'
'
Option Compare Database
Option Explicit     'SampleNo=074　WindowsXP VB6.0(SP5) 2002.05.16
'既存のプロセスオブジェクトのハンドルを取得(P665)
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
     ByVal dwProcessId As Long) As Long
'指定のプロセスの終了コードを取得（P660)
Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
'開かれているオブジェクトのハンドルを解放する（P1252)
Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&


Private Sub ShellEnd(ProcessID As Long)
    Dim hProcess As Long
    Dim EndCode As Long
    Dim EndRet   As Long
    'ハンドルを取得する
     hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, ProcessID)
    '終わるまで待つ
    Do
        EndRet = GetExitCodeProcess(hProcess, EndCode)
        DoEvents
    Loop While (EndCode = STILL_ACTIVE)
    'ハンドルを閉じる
     EndRet = CloseHandle(hProcess)
End Sub


Private Sub Command1_Click()
'メモ帳を起動し、終了したら電卓を起動する
    Dim Ret1 As Long
    Dim Ret2 As Long
    Dim Ret3 As Long
    
    Ret1 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★日報log_local.mdb", vbNormalNoFocus)
    'Ret1 = Shell("C:\WINDOWS\notepad.exe", 1)
    ShellEnd (Ret1)        '終了するまで待機
    'MsgBox ("メモ帳が終了しました。")

    Ret2 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★顧客マスタlog_local.mdb", vbNormalNoFocus)
    'Ret2 = Shell("C:\WINDOWS\CALC.EXE", 1)
      
    ShellEnd (Ret2)
    'MsgBox ("電卓が終了しました。")
    
    Ret3 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★備品マスタlog_local.mdb", vbNormalNoFocus)
    ShellEnd (Ret3)
End Sub


'
'

Option Compare Database

Option Explicit 'SampleNo=074　WindowsXP VB6.0(SP5) 2002.05.16

'既存のプロセスオブジェクトのハンドルを取得(P665)

Private Declare Function OpenProcess Lib "kernel32" _

(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _

ByVal dwProcessId As Long) As Long

'指定のプロセスの終了コードを取得（P660)

Private Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long

'開かれているオブジェクトのハンドルを解放する（P1252)

Private Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long

Private Const PROCESS_QUERY_INFORMATION = &H400&

Private Const STILL_ACTIVE = &H103&

Private Sub ShellEnd(ProcessID As Long)

Dim hProcess As Long

Dim EndCode As Long

Dim EndRet As Long

'ハンドルを取得する

hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, ProcessID)

'終わるまで待つ

EndRet = GetExitCodeProcess(hProcess, EndCode)

DoEvents

Loop While (EndCode = STILL_ACTIVE)

'ハンドルを閉じる

EndRet = CloseHandle(hProcess)

End Sub

Private Sub Command1_Click()

'メモ帳を起動し、終了したら電卓を起動する

Dim Ret1 As Long

Dim Ret2 As Long

Dim Ret3 As Long

Ret1 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★日報log_local.mdb", vbNormalNoFocus)

'Ret1 = Shell("C:\WINDOWS\notepad.exe", 1)

ShellEnd (Ret1) '終了するまで待機

'MsgBox ("メモ帳が終了しました。")

Ret2 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★顧客マスタlog_local.mdb", vbNormalNoFocus)

'Ret2 = Shell("C:\WINDOWS\CALC.EXE", 1)

ShellEnd (Ret2)

'MsgBox ("電卓が終了しました。")

Ret3 = Shell("C:\Program Files\Microsoft Office\Office\MSACCESS.EXE D:\test\D１吸★備品マスタlog_local.mdb", vbNormalNoFocus)

ShellEnd (Ret3)

End Sub

　　
　　
★ 一定時間待つ方法(タイマ時イベントを使った方法)
一定時間待つ方法(タイマ時イベントを使った方法)

MENU

関連記事

最近の投稿

カテゴリー

MENU

★★Access2000VBA・Excel2000VBA独学～Win32API。Shell関数で実行したコマンドラインの命令を待機する～その他関連事項も

関連記事

最近の投稿

カテゴリー

タグ