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

access

wtorek, 01 marca 2005
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
piątek, 11 lutego 2005
funkcja sprawdza, czy wciśnięta na formularzu sekwencja klawiszy odpowiada zdefiniowanemu hasłu, przekazanemu jako parametr
ja tego używam na formularzach przy zdarzeniu On Key Press (Przy naciśnięciu klawisza). Wywołuję tym jakieś ukryte możliwości (np. jakiś konfigurator albo edycję ukrytych pól...)

Uwaga: właściwość formularza KeyPreview (Podgląd Klawiszy) musi być włączony na Yes/Tak.

Public Function VerifyPassword(passwd As String, KeyAscii As Integer) As Boolean
Static keycount As Integer
Dim prevcount As Integer
prevcount = keycount
If AscW(Mid(passwd, keycount + 1, 1)) = KeyAscii Then keycount = keycount + 1
If prevcount = keycount Then keycount = 0
If keycount = Len(passwd) Then VerifyPassword = True: keycount = 0
End Function
środa, 02 lutego 2005

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


Public Function SubDatasheetName_Auto2None()
On Error Resume Next
Dim tbl As TableDef, strName As String, prp As Property, i As Integer, isSubDSN As Boolean

i = 0
SysCmd acSysCmdInitMeter, "Changing SubDataSheet Names to [None]...", _
CurrentDb.TableDefs.Count
For Each tbl In CurrentDb.TableDefs
i = i + 1
If Not Left(tbl.Name, 4) = "MSys" And tbl.RecordCount <> -1 Then 'sprawdza tylko tablice NIESYSTEMOWE i NIE LINKOWANE (linkowane mają RecordCount = -1)
isSubDSN = False
For Each prp In tbl.Properties
If prp.Name = "SubDataSheetName" Then isSubDSN = True
Next prp
If Not isSubDSN Then
Set prp = tbl.CreateProperty("SubDataSheetName", dbText, "[None]")
tbl.Properties.Append prp
tbl.Properties.Refresh
End If
End If
SysCmd acSysCmdUpdateMeter, i
Next tbl
SysCmd acSysCmdRemoveMeter
End Function
bloxowe porady

RSS


dodaj do netvibes

Add to Google


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