eksperymenty z internetem, blogami, bloxem, javascriptem, firefoxem czy różnymi użytecznymi programami czy narzędziami, tak okołoinformatycznie tudzież okołokomputerowo...
Blog > Komentarze do wpisu

ACCESS: RunProgram and Wait

Funkcja pozwala uruchomić dowolną zewnętrzną aplikację/program z poziomu Accessa i opcjonalnie czekać na jego zakończenie.
Ja tego często używam do wywołania zewnętrznych skryptów *.bat systemu operacyjnego w procedurach obsługi importu/exportu danych w Accesie.
Funkcja od SKowala, nieznacznie przerobiona

Najlepiej skopiować do nowego modułu.

Option Compare Database
Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Private Declare Function GetInputState Lib "user32" () As Long

Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Public Sub RunProgram(ByVal strPrg As String, ByVal bWait As Boolean)
Dim pID As Long, lRet As Long, hProcess As Long

On Error GoTo blad
DoEvents
If Not FileExist(strPrg) Then MsgBox "Nie mogę znależć pliku " & strPrg, vbExclamation: Exit Sub
pID = Shell(strPrg, vbNormalFocus)
If bWait Then
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pID)
Do
GetExitCodeProcess hProcess, lRet 'Czy juz sie zakonczyl?
If GetInputState() Then DoEvents 'Pozwalamy na obsluge kolejki komunikatow, o ile takowe sa
Sleep 100 'Jesli sprawdzanie nie musi sie odbywac bardzo czesto, mozna tu wywolac funkcje Sleep z w miare krotkim czasem, np.:
Loop While lRet = STILL_ACTIVE
CloseHandle hProcess
End If
Exit Sub

blad:
MsgBox "Podczas uruchamiania aplikacji " & strPrg & " wystąpił błąd " & vbCrLf & Err.Number & " " & Err.Description
End Sub
wtorek, 01 marca 2005, sgk

Polecane wpisy

  • iphone 3gs czy nokia n97?

    Osiołkowi w żłoby dano. W jeden owies, w drugi, siano. Uchem strzyże, głową kręci. I to pachnie, i to nęci.Aleksander Fredro , "Bajeczka o osiołku" Mam mały dy

  • dropbox daje [nowym] dodatkowe miejsce

    Jeśli ktoś jeszcze nie zdecydował się na korzystanie z Dropboxa (a według mnie naprawdę warto ) to teraz jest okazja na zyskanie na starcie dodatkowych 250MB

  • ACCESS: SubDataSheet: from [Auto] to [None]

    funkcja zmieniająca właściwość SubdatasheetName tabel lokalnych z [Auto] na [None] co znacznie przyspiesza pracę z nimi... Public Function SubDatasheetName_Auto

TrackBack
TrackBack w tym blogu jest moderowany. TrackBack URL do wpisu:
bloxowe porady

RSS


dodaj do netvibes

Add to Google


pobierz Spiceworks - darmowe oprogramowanie do zarządzania infrastrukturą IT