• 締切済み

karnell32エラー(訂正：EXE間でデータを受け渡し時の～) ２

maruru01の回答

  • maruru01
  • ベストアンサー率51% (1179/2272)
回答No.1

これで私は出来ました。(VB6.0) 試してみて下さい。 では。 （標準モジュール） '関数の宣言 Public Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400& Public Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const STATUS_PENDING = &H103& Public Const STILL_ACTIVE = STATUS_PENDING Public Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As Long 'アプリケーションを起動し、終了するまで待機する関数 Public Sub WaitShell(AppPath As String, Optional SizeFocusmode As Integer = vbNormalFocus) Dim AppID As Long 'Shell関数の戻り値 Dim Process As Long 'OpenProcess関数の戻り値 Dim ExitCode As Long '終了コード Dim rc As Long AppID = Shell(AppPath, SizeFocusmode) Process = OpenProcess(PROCESS_QUERY_INFORMATION, 1, AppID) 'プロセスが終了していない間はDoEvents関数でOSに制御を戻す Do rc = GetExitCodeProcess(Process, ExitCode) DoEvents Loop While ExitCode = STILL_ACTIVE rc = CloseHandle(Process) End Sub （フォームモジュール） 前部略 Dim koAppPath As String '子EXEファイルのフルパス 中略 oyaForm.Enabled = False　　　　'親フォーム使用不可 WaitShell koAppPath oyaForm.Enabled = True　　　　 '親フォーム使用可 後部略

この回答がついた質問に戻る
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • GetProcessWorkingSetSizeでエラーが発生します

    VB6で画像処理アプリケーションの開発を行っている者です。 下記記述でワーキングセット領域を変更しようとしていますが、GetProcessWorkingSetSizeの部分でエラーが発生します。 使用PCにより、「問題が発生したため、Visual Basic を終了します。 ご不便をおかけして申し訳ありません。」や有無を言わさず開発環境が終了してしまう場合がありますが、いずれにしても原因が分かりません。 どなたかアドバイスいただけませんでしょうか？ よろしくお願い致します。 (標準モジュールで宣言) Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long Declare Function GetProcessWorkingSetSize Lib "kernel32" (ByVal qq As Integer, ByVal pp As Integer, ByVal rr As Integer) As Long Declare Function SetProcessWorkingSetSize Lib "kernel32" (ByVal phph1 As Long, ByVal wkminwkmin1 As Long, ByVal wkmaxwkmax1 As Long) As Long Declare Function GetLastError Lib "kernel32.dll" () As Long (実行部) Sub WorkingSetChange() Dim id As Long 'アプリケーションプログラムのID用変数 Dim ph As Long 'アプリケーションプログラムのハンドル用変数 Dim wkmin As Long '最小ワーキングセット用変数 Dim wkmax As Long '最大ワーキングセット用変数 Dim bret As Long Const PROCESS_SET_QUOTA = &H100 Const PROCESS_QUERY_INFORMATION = &H400 'アプリケーションプログラムのIDを取得する id = GetCurrentProcessId() 'アプリケーションプログラムのハンドルをオープンする ph = OpenProcess(PROCESS_SET_QUOTA + PROCESS_QUERY_INFORMATION, False, id) 'アプリケーションプログラムの最大ワーキングセット値と最小ワーキングセット値を取得 bret = GetProcessWorkingSetSize(ph, wkmin, wkmax) '最小ワーキングセット値を1MBに設定 wkmin = 1 * 1024 * 1024 '最大ワーキングセット値を3MBに設定 wkmax = 3 * 1024 * 1024 'アプリケーションプログラムの最大ワーキングセット値と最小ワーキングセット値を変更 bret = SetProcessWorkingSetSize(ph, wkmin, wkmax) 'アプリケーションプログラムのハンドルをクローズする bret = CloseHandle(ph) End Sub

  • ExcelVBAでのkernel32(64bit)

    今までExcel2000のVBAから、以下のようなコードを使ってC++で作ったコマンドプロンプトで動くプログラムを動かすプログラムを作っていましたが、これを64bitのWindows7上で動いているExcel2010で使おうとしたらメッセージが出ました。いろいろ調べてみたところ、たぶんDeclareにPtrSafeを付ければ良いようなのですが、その際、他のコードはそのままで良いのでしょうか。特に、コード中のLongはそのままで良いのか気になるのですが...。ちなみに、下記コードの条件コンパイルはネットで調べて見よう見まねで付けたもので、Excel2000のときには付けていないものでした。ご存じの方がいらっしゃいましたらご教授ください。 '------------------------------------------------------------------------------ ' Win32 API関数・定数の宣言 '------------------------------------------------------------------------------ #If VBA7 And Win64 Then '64bit Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ 　　ByVal dwMilliseconds As Long) As Long Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ 　　ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #Else '32bit Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ 　　ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ 　　ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #End If Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const INFINITE As Long = &HFFFF '------------------------------------------------------------------------------ ' Run '------------------------------------------------------------------------------ Public Sub Run(ByVal project_name As String) 　　Dim program As String 　　Dim task_id As Long 　　Dim h_proc As Variant 　　program = mdlFunc.ProgramPath() & mdlFunc.ProgramOption(project_name) 'プログラム名 　　task_id = Shell(program, vbHide) 　　h_proc = OpenProcess(PROCESS_ALL_ACCESS, False, task_id) 　　If OpenProcess(PROCESS_ALL_ACCESS, False, task_id) <> vbNull Then 　　　　Call WaitForSingleObject(h_proc, INFINITE) 　　　　CloseHandle h_proc 　　End If End Sub

  • APIを使う時は参照設定は不要？

    例えば Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub test() Dim Handle As Long Handle = FindWindow("IEFrame", vbNullString) Debug.Print Handle End Sub と言うコードでウィンドウハンドルを取得する場合、 参照設定のどこにもチェックを入れませんが、なぜ参照設定しなくても使えるのでしょうか？ Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long が参照設定の代わりになるのですか？

  • このプログラムの問題点を教えてください。

    Public Cass test1 Private mBool As Boolean <Browsable(False)> _ Public Property Bool() As Boolean Get Return mBool End Get Set(ByVal value As Boolean) mBool = value End Set End Property Private GetNo(ByVal No As Integer, ByVal count As Integer) As Integer Dim intNewNo As Integer = 0 If (No + count) > 99999 Then mBool = True Else mBool = False inNewNo = No + count End If Return intNewNo End Function ※このプロパティを別のクラスで使用しました。 Public Class test2 Public sub Handan() Dim Han As test1 = New test1 If Han.Bool = True Then MsgBox("Yes") Else MsgBox("No") End If End Sub 多少端折りましたが、以上のようなプログラムを書きました。 Getnoメソッドは、test2クラスの別のメソッドで使われていたのですが、 Getnoの値によって処理を変えたかっただめ、test1にプロパティを作って 判断できるようにしました。 このコードをレビューしてもらったところ、なにか問題があったようなのですが （プロパティの意味がないとか、そういう趣旨の） レビューした本人と連絡がとれないため、どこがおかしいのかわからず困っています。 このBoolプロパティの使い方、問題がありましたら、教えてください。

  • ＵＷＳＣがうまく動かない

    ExcelからＵＷＳＣを使って他のソフト2個を動かして又、Excelに 戻ってくるのですが、ＵＷＳＣが重なって動作を同時に行う為、次のソフトで実行してみました。すると同時には動作せずに1個のプログラムの動作が終わって次ののプログラムを実行してくれて良くのですが、戻るときにExcelプログラムが真っ白に表示されて上の部分にファイル名と応答無と出てそれ以上進みません。UWSCソフトを終了すれば元には戻りますが、うまく操作をさせるにはどうすれば良いですか？よろしくお願いします。 ＵＷＳＣの動きは⇒スタートボタンの横のタスクバーにあるソフトをクリックから始まり⇒終わったら又、Excelのタブをクリックして戻ります。 次のソフトはWebで見つけたソフトです。 外部プログラムの実行と処理待ち そこで、以下のサンプルマクロでは、Shell関数を使用して外部プログラムを実行し、そのプログラムが終了するまで待つように処理を施してあります。 ＊もうひとつの質問ですが、Win32 API関数の宣言はどこに記載をすればいいのですか？ このままエディータに書けばいいのでしょうか '--- Win32 API 関数の宣言 --- Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '--- Win32 API 定数の宣言 --- Global Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Global Const INFINITE As Long = &HFFFF Sub WaitRun() Dim TaskId As Long 'タスクＩＤ Dim hProc As Variant 'プロセスハンドル ' 外部プログラムの実行 TaskId = Shell("c:\Test.bat", 2) ' プロセスハンドルの取得 hProc = OpenProcess(PROCESS_ALL_ACCESS, False, TaskId) ' プロセスのオープン If OpenProcess(PROCESS_ALL_ACCESS, False, TaskId) <> vbNull Then ' プロセスのシグナル待ち Call WaitForSingleObject(hProc, INFINITE) ' プロセスクローズ CloseHandle hProc End If

  • 0から12までの値ｎを入力し、ｎと階乗ｎ！の値を表示しなさいという問題

    0から12までの値ｎを入力し、ｎと階乗ｎ！の値を表示しなさいという問題です。 前にこのプログラムで複数個、同時には計算できない問題を自分で解決したのですがこんどは０が計算できないようです。 System.StackOverflowException' のハンドルされていない例外が WindowsApplication1.exe で発生しました。　とでます Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim n As Long Dim f As Long n = CLng(TextBox1.Text) TextBox2.Text = CStr(Recur(n)) End Sub Public Function Recur(ByVal arg As Long) As Long　←ここにエラーが If arg = 1 Then Recur = arg Exit Function End If Recur = arg * Recur(arg - 1) End Function End Class というプログラムです。分かる方よろしくお願いします。 実行エラーです。

  • 素数を求めるマクロを

    走らすと暴走したようになり、素数＝１５１で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める() 　　Dim i As Long 　　Dim j As Long 　　Dim m As Long 　　Dim p As Long 　　Dim flg As Boolean 　　i = 1 　　j = 1 　　p = 2 　　Do 　　　　flg = False 　　　　For m = 2 To Int(Sqr(p)) 　　　　　　If p Mod m = 0 Then 　　　　　　　　flg = True 　　　　　　　　Exit For 　　　　　　End If 　　　　Next 　　　　If flg = False Then 　　　　　　Cells(i, j) = p 　　　　　　i = i + 1 　　　　　　If i > Rows.Count Then 　　　　　　　　i = 1 　　　　　　　　j = j + 1 　　　　　　End If 　　　　End If 　　　　p = p + 1 　　Loop End Sub ======================

  • ファイルの有無を確認した際のエラーについて

    ＶＢ６です。以下の様な関数を使っています。 用途としては、ファイルの有無を調べています。 で、関数の値として実際のパソコンに存在しないフォルダを指定した際、 下のエラー処理（AAA）に飛びません。 わかる方いらしたら、よろしくお願いします。 Public Function files(ByVal strPathName As String) As Boolean On Error GoTo AAA If (GetAttr(strPathName) And vbDirectory) = vbDirectory Then Stop Else Stop End If Exists2 = True Exit Function AAA: Stop End Function

  • VBA実行時のエラー

    下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。 このプログラムをシートから実行した所 エラー：400『既にフォームは表示されています。モーダルにできません。』 なるものが表示されてしまいます。 またコードを記述する所から実行しますと 実行時エラー：１００４『アプリケーション定義またはオブジェクト定義のエラー』 となってしまいます。 私の努力が足りないのは重々承知ですが、解決する事が出来ません。 皆様のお力を借りることが出来たらと思い投稿しました。 宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub

  • 0から12までの値ｎを入力し、ｎと階乗ｎ！の値を表示しなさいという問題

    0から12までの値ｎを入力し、ｎと階乗ｎ！の値を表示しなさいという問題ですが、一つの数字しか計算が出来ません 5と１２の場合は String "5 12" から型 'Long' への変換は無効です。と出てきてしまいます。 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim n As Long Dim f As Long n = CLng(TextBox1.Text) ←ここにエラーが出ます。 TextBox2.Text = CStr(Recur(n)) End Sub Public Function Recur(ByVal arg As Long) As Long If arg = 1 Then Recur = arg Exit Function End If Recur = arg * Recur(arg - 1) End Function End Class というプログラムです。分かる方よろしくお願いします。 実行エラーです。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する