I was always under the impression that VBA is only able to interact with MS Office applications. I recently learned that there are some operating system functions and features that are accessible with VBA, but I don't know anything about them. Could someone point me in the right direction so I can reasearch this further? Any general hints or tips about this would also be appreciated.
Thanks
3 1601 NeoPa 32,556
Expert Mod 16PB
This is complicated for two reasons : - Basic (and derivative) languages store and manipulate strings differently from how C (and derivative) languages do it.
- In the former a string is represented by a length value at the start point of the string followed by that number of ASCII characters in successive memory locations.
- In the latter the string starts with the list od ASCII characters in successive locations and terminated with a Null character (whose value is 0).
The Windows O/S is basically written in, and to interact with, the latter. IE. Strings passed by a call from Basic type languages will not be recognised for what they are and this must be handled in code that calls, and receives data back from calls, to the O/S. - There appears to be no reference to the O/S so any procedures that need to be called also need to be declared manually in your code.
In case some example code helps here is a module I use for a limited number of calls that I use in my work from time-to-time. - Option Compare Database
-
Option Explicit
-
-
'Windows API Variable Prefixes
-
'cb = Count of Bytes (32-bit)
-
'w = Word (16-bit)
-
'dw = Double Word (32-bit)
-
'lp = Long Pointer (32-bit)
-
'b = Boolean (32-bit)
-
'h = Handle (32-bit)
-
'ul = Unsigned Long (32-bit)
-
-
Public Const conHKCR = &H80000000
-
Public Const conHKCU = &H80000001
-
Public Const conHKLM = &H80000002
-
Public Const conHKU = &H80000003
-
Public Const conStandardRightsAll = &H1F0000
-
Public Const conReadControl = &H20000
-
Public Const conStandardRightsRead = (conReadControl)
-
Public Const conRegSz = 1
-
Public Const conOK = 0&
-
Public Const conKeyQueryValue = &H1
-
Public Const conKeySetValue = &H2
-
Public Const conKeyCreateLink = &H20
-
Public Const conKeyCreateSubKey = &H4
-
Public Const conKeyEnumerateSubKeys = &H8
-
Public Const conKeyNotify = &H10
-
Public Const conSynchronise = &H100000
-
Public Const conRegOptionNonVolatile = 0
-
Public Const conKeyAllAccess = ((conStandardRightsAll _
-
Or conKeyQueryValue _
-
Or conKeyCreateSubKey _
-
Or conKeyEnumerateSubKeys _
-
Or conKeyNotify _
-
Or conKeyCreateLink) _
-
And (Not conSynchronise))
-
Public Const conKeyRead = ((conReadControl _
-
Or conKeyQueryValue _
-
Or conKeyEnumerateSubKeys _
-
Or conKeyNotify) _
-
And (Not conSynchronise))
-
-
Private Const conUseShowWindow = &H1&
-
Private Const conNormalPriority = &H20&
-
Private Const conInfinite = -1&
-
Private Const conWinVis = &H10000000
-
Private Const conGWLStyle = -&H10&
-
-
Private Type typStartupInfo
-
cbLen As Long
-
lpReserved As String
-
lpDesktop As String
-
lpTitle As String
-
dwX As Long
-
dwY As Long
-
dwXSize As Long
-
dwYSize As Long
-
dwXCount As Long
-
dwYCount As Long
-
dwFillAtt As Long
-
dwFlags As Long
-
wShowWindow As Integer
-
cbReserved2 As Integer
-
lpReserved2 As Long
-
hStdIn As Long
-
hStdOut As Long
-
hStdErr As Long
-
End Type
-
-
Private Type typProcInfo
-
hProc As Long
-
hThread As Long
-
dwProcID As Long
-
dwThreadID As Long
-
End Type
-
-
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
-
Alias "RegOpenKeyExA" (ByVal hKey As Long, _
-
ByVal lpSubKey As String, _
-
ByVal ulOptions As Long, _
-
ByVal samDesired As Long, _
-
phkResult As Long) As Long
-
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
-
As Long
-
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" _
-
Alias "RegQueryValueExA" (ByVal hKey As Long, _
-
ByVal lpValueName As String, _
-
ByVal lpReserved As Long, _
-
lpType As Long, _
-
ByVal lpData As String, _
-
lpcbData As Long) As Long
-
-
Private Declare Function CreateProcessA Lib "kernel32" ( _
-
ByVal lpApplicationName As Long, _
-
ByVal lpCommandLine As String, _
-
ByVal lpProcessAttributes As Long, _
-
ByVal lpThreadAttributes As Long, _
-
ByVal bInheritHandles As Long, _
-
ByVal dwCreationFlags As Long, _
-
ByVal lpEnvironment As Long, _
-
ByVal lpCurrentDirectory As Long, _
-
lpStartupInfo As typStartupInfo, _
-
lpProcessInformation As typProcInfo) As Long
-
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
-
ByVal hHandle As Long, _
-
ByVal dwMilliseconds As Long) As Long
-
Private Declare Function CloseHandle Lib "kernel32" ( _
-
ByVal hObject As Long) As Long
-
-
Private Declare Function FindWindowEx Lib "user32" _
-
Alias "FindWindowExA" (ByVal hwndParent As Long, _
-
ByVal hwndChildAfter As Long, _
-
ByVal lpszClass As String, _
-
ByVal lpszWindow As String) As Long
-
Private Declare Function GetWindowLong Lib "user32" _
-
Alias "GetWindowLongA" (ByVal hwndID As Long, _
-
ByVal nIndex As Long) As Long
-
Private Declare Function IsMaximised Lib "user32" _
-
Alias "IsZoomed" (ByVal hWnd As Long) As Boolean
-
Private Declare Function IsMinimised Lib "user32" _
-
Alias "IsIconic" (ByVal hWnd As Long) As Boolean
-
Private Declare Function ShowWindow Lib "user32" _
-
(ByVal hWnd As Long, _
-
ByVal nCmdShow As Long) As Long
-
Private Declare Function GetUserName Lib "advapi32.dll" _
-
Alias "GetUserNameA" (ByVal lpBuffer As String, _
-
lpnSize As Long) As Long
-
-
Public Function RegRead(ByVal lngHive As Long, _
-
ByVal strKey As String, _
-
ByVal strValue As String) As Variant
-
Dim intIdx As Integer, intHK As Integer
-
Dim strWork As String
-
Dim lngRet As Long, cbLen As Long, lngHKey As Long, lngType As Long
-
-
RegRead = Null
-
strKey = strKey & Chr(0)
-
lngRet = RegOpenKeyEx(lngHive, strKey, 0, conKeyRead, lngHKey)
-
If lngRet = conOK Then
-
'Create buffer to store value
-
strWork = Space(255)
-
cbLen = 255
-
lngRet = RegQueryValueExStr(lngHKey, _
-
strValue, _
-
0&, _
-
lngType, _
-
strWork, _
-
cbLen)
-
RegRead = Left(strWork, cbLen - 1)
-
If Len(RegRead) = 254 Then RegRead = Null
-
'Close key
-
Call RegCloseKey(lngHKey)
-
End If
-
End Function
-
-
'ShellWait() executes a command synchronously (Shell() works asynchronously).
-
Public Sub ShellWait(strCommand As String, _
-
Optional intWinStyle As Integer = vbNormalFocus)
-
Dim objProcInfo As typProcInfo
-
Dim objStart As typStartupInfo
-
Dim lngRet As Long
-
-
'Initialize the typStartupInfo structure:
-
With objStart
-
.cbLen = Len(objStart)
-
.dwFlags = conUseShowWindow
-
.wShowWindow = intWinStyle
-
End With
-
'Start the shelled application:
-
Call CreateProcessA(lpApplicationName:=0&, _
-
lpCommandLine:=strCommand, _
-
lpProcessAttributes:=0&, _
-
lpThreadAttributes:=0&, _
-
bInheritHandles:=1&, _
-
dwCreationFlags:=conNormalPriority, _
-
lpEnvironment:=0&, _
-
lpCurrentDirectory:=0&, _
-
lpStartupInfo:=objStart, _
-
lpProcessInformation:=objProcInfo)
-
'Wait for the shelled application to finish
-
Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
-
dwMilliseconds:=conInfinite)
-
Call CloseHandle(hObject:=objProcInfo.hProc)
-
End Sub
-
-
Public Function DBWindowVisible() As Boolean
-
Dim hWnd As Long, lngStyle As Long
-
-
'Get handle of MDIClient window of current application
-
hWnd = FindWindowEx(hWndAccessApp, 0, "MDIClient", vbNullString)
-
'Within that, find child window matching class Odb (database window)
-
hWnd = FindWindowEx(hWnd, 0, "Odb", vbNullString)
-
'Default result to False in case handle wasn't found
-
DBWindowVisible = False
-
If (hWnd) Then
-
'Having found window, check the visibility flag of its style value
-
lngStyle = GetWindowLong(hWnd, conGWLStyle)
-
DBWindowVisible = ((lngStyle And conWinVis) = conWinVis)
-
End If
-
End Function
-
-
'AppWindowState() returns and/or sets the app's window state.
-
Public Function AppWindowState(appVar As Application, _
-
Optional strSet As String = "Read") As String
-
Dim blnVisible As Boolean
-
-
With appVar
-
AppWindowState = "Restore"
-
If IsMaximised(.hWndAccessApp) Then AppWindowState = "Maximise"
-
If IsMinimised(.hWndAccessApp) Then AppWindowState = "Minimise"
-
If strSet = "Read" Then Exit Function
-
If strSet <> AppWindowState Then
-
blnVisible = .Visible
-
If Not blnVisible Then .Visible = True
-
Select Case strSet
-
Case "Maximise"
-
Call .RunCommand(acCmdAppMaximize)
-
Case "Minimise"
-
Call .RunCommand(acCmdAppMinimize)
-
Case "Restore"
-
Call .RunCommand(acCmdAppRestore)
-
End Select
-
If Not blnVisible Then .Visible = False
-
End If
-
End With
-
End Function
-
-
'GetLogonName() determines the logon ID of the current user.
-
Public Function GetLogonName() As String
-
Dim lngMax As Long
-
Dim strBuffer As String
-
-
lngMax = &HFF
-
strBuffer = String(lngMax, vbNullChar)
-
Call GetUserName(lpBuffer:=strBuffer, lpnSize:=lngMax)
-
GetLogonName = Trim(Left(strBuffer, lngMax - 1))
-
End Function
-
-
'GetUserObject() returns an IADs object representing either the LDAP: string
-
' if passed, or the logged-on user otherwise.
-
Public Function GetUserObject(Optional ByVal strDN As String = "") As Object
-
On Error Resume Next
-
'If incorrect strDN passed then returned value will be a Nothing.
-
If strDN > "" Then
-
Set GetUserObject = GetObject("LDAP://" & strDN)
-
Else
-
strDN = "LDAP://OU=MyBusiness," & _
-
GetObject("LDAP://RootDSE").Get("rootDomainNamingContext")
-
Set GetUserObject = ProcessIAD(GetObject(strDN), GetLogonName())
-
End If
-
End Function
-
-
'ProcessIAD() is called recursively and returns an object only when it is a user
-
' that matches strUser.
-
Private Function ProcessIAD(ByRef iadVar As Object, strUser As String) As Object
-
Dim iadWork As Object
-
-
With iadVar
-
Select Case IADType(iadVar)
-
Case "User"
-
If .sAMAccountName = strUser Then Set ProcessIAD = iadVar
-
Exit Function
-
Case "organizationalUnit"
-
For Each iadWork In iadVar
-
Set ProcessIAD = ProcessIAD(iadWork, strUser)
-
If Not ProcessIAD Is Nothing Then Exit Function
-
Next iadWork
-
End Select
-
End With
-
End Function
-
-
'IADType() returns whether the IAD should be treated as a container
-
' (organizationalUnit), a user (user), or simply ignored (group).
-
Private Function IADType(iadVar As Object) As String
-
Dim varWork As Variant
-
-
With iadVar
-
Call .GetInfo
-
For Each varWork In .Get("objectClass")
-
Select Case varWork
-
Case "user", "group", "organizationalUnit"
-
IADType = varWork
-
Exit For
-
End Select
-
Next varWork
-
End With
-
End Function
-
-
'ShowIADs() shows all users, groups and containers of the AD from strRoot.
-
Public Sub ShowIADs(Optional ByRef iadVar As Object, _
-
Optional ByVal strRoot As String = "")
-
Dim iadWork As Object
-
Dim strWork As String
-
-
If iadVar Is Nothing Then
-
strWork = "LDAP://" & _
-
strRoot & _
-
"OU=MyBusiness," & _
-
GetObject("LDAP://RootDSE").Get("rootDomainNamingContext")
-
Set iadVar = GetObject(strWork)
-
End If
-
With iadVar
-
strWork = IADType(iadVar)
-
If strWork > "" Then
-
Debug.Print strWork & "," & _
-
IIf(strWork = "user", .sAMAccountName, "") & "#" & _
-
.distinguishedName & "~";
-
End If
-
Select Case strWork
-
Case "user"
-
Exit Sub
-
Case "organizationalUnit"
-
For Each iadWork In iadVar
-
Call ShowIADs(iadWork)
-
Next iadWork
-
End Select
-
End With
-
End Sub
Thanks for the info NeoPa. I've been looking into your code and it is a bit beyond my capabilities. I tried doing some research and I found that Windows has functions that are available for "middleware" software, which I take it are your references to kernel32, advapi32.dll, and user32. These must be library references with system defined functions that are available for programmers, but I wouldn't even know what they're used for or how they would help. I'm going to set it aside for now. All in due time I guess.
I do have a specific question though. At the beginning of your module in the Constant declarations why do the values take the format they they're in with the "&" and "-" and "H" followed by a series of numbers?
NeoPa 32,556
Expert Mod 16PB
The only time a "-" appears is when the value is negative, but let's deal with the other two which are less clear : - &H --> as a prefix indicates the following data should be treated as a hex(adecimal) value. You may notice letters up to "F" in the values which are valid hex digits.
- & --> as a suffix means that the literal value preceeding it is of type Long.
Sign in to post your reply or Sign up for a free account.
Similar topics
by: David Brown |
last post by:
Hello. I recently came across a free operating system called Unununium (or
something like that) and it was developed in Python and Assembly.
Now, I have been looking for a way to make an...
|
by: Kevin A |
last post by:
Hi,
Is there a way to determine the name and version of the
operating system in a portable way? (for Solaris/Linux)
Thanks,
Kevin
|
by: Vavel |
last post by:
Hi all!
I want to insert the record into the table by
using an application program that includes the following statements:
EXEC SQL BEGIN DECLARE SECTION;
long hvInt_Stor;
long hvExt_Stor;...
|
by: viper7 |
last post by:
Can I run the c++ compiler on the operating system that I have.. Windows nt 4 ser.pack 6a.. I understan
that the compiled programs will run on my system.. I need to know if anyone is using the...
|
by: evan |
last post by:
Hi anyone,
I have to distribute a VB.NET project that requires the installation of
Jet 4.0. As the installation files of Jet are operating system
specific, during deployment I need to run the...
|
by: gamehack |
last post by:
Hi all,
I've been thinking about all the system functions which accept wchar_t.
The point is that they don't define what encoding the wchar_t has to
be. Let us assume that all the exernal input...
|
by: PythonUsr |
last post by:
Although I know for a fact that an Operating System can be written in
Python, I need to ask some questions to the more advanced users of
Python.
Uuu and Cleese are two operating systems that...
|
by: newstips6706 |
last post by:
The Operating System of Organic Machines
Building your own "KERNEL".
--------------------------------------------------------------------------------
|
by: jdresow |
last post by:
I installed MySQL on a windows server 2003, in an acxtive directory domain and I get error 32 which is a sharing error. I do not understand this and I am also adding the first several lines of my...
|
by: pavanip |
last post by:
Hi,
I have developed one windows application using vb.net. I have setup that application on windows operating system its working fine on windows os. Now I am trying to do that exe run on Mac...
|
by: DolphinDB |
last post by:
Tired of spending countless mintues downsampling your data? Look no further!
In this article, you’ll learn how to efficiently downsample 6.48 billion high-frequency records to 61 million...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: PapaRatzi |
last post by:
Hello,
I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
|
by: Defcon1945 |
last post by:
I'm trying to learn Python using Pycharm but import shutil doesn't work
|
by: Shællîpôpï 09 |
last post by:
If u are using a keypad phone, how do u turn on JavaScript, to access features like WhatsApp, Facebook, Instagram....
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
|
by: Faith0G |
last post by:
I am starting a new it consulting business and it's been a while since I setup a new website. Is wordpress still the best web based software for hosting a 5 page website? The webpages will be...
| |