By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,294 Members | 2,645 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,294 IT Pros & Developers. It's quick & easy.

VBA Operating System Functions and Features

100+
P: 104
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
Mar 9 '14 #1
Share this Question
Share on Google+
3 Replies


NeoPa
Expert Mod 15k+
P: 31,494
This is complicated for two reasons :
  1. 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.
  2. 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.
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. 'Windows API Variable Prefixes
  5. 'cb = Count of Bytes (32-bit)
  6. 'w  = Word (16-bit)
  7. 'dw = Double Word (32-bit)
  8. 'lp = Long Pointer (32-bit)
  9. 'b  = Boolean (32-bit)
  10. 'h  = Handle (32-bit)
  11. 'ul = Unsigned Long (32-bit)
  12.  
  13. Public Const conHKCR = &H80000000
  14. Public Const conHKCU = &H80000001
  15. Public Const conHKLM = &H80000002
  16. Public Const conHKU = &H80000003
  17. Public Const conStandardRightsAll = &H1F0000
  18. Public Const conReadControl = &H20000
  19. Public Const conStandardRightsRead = (conReadControl)
  20. Public Const conRegSz = 1
  21. Public Const conOK = 0&
  22. Public Const conKeyQueryValue = &H1
  23. Public Const conKeySetValue = &H2
  24. Public Const conKeyCreateLink = &H20
  25. Public Const conKeyCreateSubKey = &H4
  26. Public Const conKeyEnumerateSubKeys = &H8
  27. Public Const conKeyNotify = &H10
  28. Public Const conSynchronise = &H100000
  29. Public Const conRegOptionNonVolatile = 0
  30. Public Const conKeyAllAccess = ((conStandardRightsAll _
  31.                               Or conKeyQueryValue _
  32.                               Or conKeyCreateSubKey _
  33.                               Or conKeyEnumerateSubKeys _
  34.                               Or conKeyNotify _
  35.                               Or conKeyCreateLink) _
  36.                             And (Not conSynchronise))
  37. Public Const conKeyRead = ((conReadControl _
  38.                          Or conKeyQueryValue _
  39.                          Or conKeyEnumerateSubKeys _
  40.                          Or conKeyNotify) _
  41.                        And (Not conSynchronise))
  42.  
  43. Private Const conUseShowWindow = &H1&
  44. Private Const conNormalPriority = &H20&
  45. Private Const conInfinite = -1&
  46. Private Const conWinVis = &H10000000
  47. Private Const conGWLStyle = -&H10&
  48.  
  49. Private Type typStartupInfo
  50.     cbLen As Long
  51.     lpReserved As String
  52.     lpDesktop As String
  53.     lpTitle As String
  54.     dwX As Long
  55.     dwY As Long
  56.     dwXSize As Long
  57.     dwYSize As Long
  58.     dwXCount As Long
  59.     dwYCount As Long
  60.     dwFillAtt As Long
  61.     dwFlags As Long
  62.     wShowWindow As Integer
  63.     cbReserved2 As Integer
  64.     lpReserved2 As Long
  65.     hStdIn As Long
  66.     hStdOut As Long
  67.     hStdErr As Long
  68. End Type
  69.  
  70. Private Type typProcInfo
  71.     hProc As Long
  72.     hThread As Long
  73.     dwProcID As Long
  74.     dwThreadID As Long
  75. End Type
  76.  
  77. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  78.     Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  79.                            ByVal lpSubKey As String, _
  80.                            ByVal ulOptions As Long, _
  81.                            ByVal samDesired As Long, _
  82.                            phkResult As Long) As Long
  83. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _
  84.                              As Long
  85. Private Declare Function RegQueryValueExStr Lib "advapi32.dll" _
  86.     Alias "RegQueryValueExA" (ByVal hKey As Long, _
  87.                               ByVal lpValueName As String, _
  88.                               ByVal lpReserved As Long, _
  89.                               lpType As Long, _
  90.                               ByVal lpData As String, _
  91.                               lpcbData As Long) As Long
  92.  
  93. Private Declare Function CreateProcessA Lib "kernel32" ( _
  94.     ByVal lpApplicationName As Long, _
  95.     ByVal lpCommandLine As String, _
  96.     ByVal lpProcessAttributes As Long, _
  97.     ByVal lpThreadAttributes As Long, _
  98.     ByVal bInheritHandles As Long, _
  99.     ByVal dwCreationFlags As Long, _
  100.     ByVal lpEnvironment As Long, _
  101.     ByVal lpCurrentDirectory As Long, _
  102.     lpStartupInfo As typStartupInfo, _
  103.     lpProcessInformation As typProcInfo) As Long
  104. Private Declare Function WaitForSingleObject Lib "kernel32" ( _
  105.     ByVal hHandle As Long, _
  106.     ByVal dwMilliseconds As Long) As Long
  107. Private Declare Function CloseHandle Lib "kernel32" ( _
  108.     ByVal hObject As Long) As Long
  109.  
  110. Private Declare Function FindWindowEx Lib "user32" _
  111.     Alias "FindWindowExA" (ByVal hwndParent As Long, _
  112.                            ByVal hwndChildAfter As Long, _
  113.                            ByVal lpszClass As String, _
  114.                            ByVal lpszWindow As String) As Long
  115. Private Declare Function GetWindowLong Lib "user32" _
  116.     Alias "GetWindowLongA" (ByVal hwndID As Long, _
  117.                             ByVal nIndex As Long) As Long
  118. Private Declare Function IsMaximised Lib "user32" _
  119.     Alias "IsZoomed" (ByVal hWnd As Long) As Boolean
  120. Private Declare Function IsMinimised Lib "user32" _
  121.     Alias "IsIconic" (ByVal hWnd As Long) As Boolean
  122. Private Declare Function ShowWindow Lib "user32" _
  123.                          (ByVal hWnd As Long, _
  124.                           ByVal nCmdShow As Long) As Long
  125. Private Declare Function GetUserName Lib "advapi32.dll" _
  126.     Alias "GetUserNameA" (ByVal lpBuffer As String, _
  127.                           lpnSize As Long) As Long
  128.  
  129. Public Function RegRead(ByVal lngHive As Long, _
  130.                         ByVal strKey As String, _
  131.                         ByVal strValue As String) As Variant
  132.     Dim intIdx As Integer, intHK As Integer
  133.     Dim strWork As String
  134.     Dim lngRet As Long, cbLen As Long, lngHKey As Long, lngType As Long
  135.  
  136.     RegRead = Null
  137.     strKey = strKey & Chr(0)
  138.     lngRet = RegOpenKeyEx(lngHive, strKey, 0, conKeyRead, lngHKey)
  139.     If lngRet = conOK Then
  140.         'Create buffer to store value
  141.         strWork = Space(255)
  142.         cbLen = 255
  143.         lngRet = RegQueryValueExStr(lngHKey, _
  144.                                     strValue, _
  145.                                     0&, _
  146.                                     lngType, _
  147.                                     strWork, _
  148.                                     cbLen)
  149.         RegRead = Left(strWork, cbLen - 1)
  150.         If Len(RegRead) = 254 Then RegRead = Null
  151.         'Close key
  152.         Call RegCloseKey(lngHKey)
  153.     End If
  154. End Function
  155.  
  156. 'ShellWait() executes a command synchronously (Shell() works asynchronously).
  157. Public Sub ShellWait(strCommand As String, _
  158.                      Optional intWinStyle As Integer = vbNormalFocus)
  159.     Dim objProcInfo As typProcInfo
  160.     Dim objStart As typStartupInfo
  161.     Dim lngRet As Long
  162.  
  163.     'Initialize the typStartupInfo structure:
  164.     With objStart
  165.         .cbLen = Len(objStart)
  166.         .dwFlags = conUseShowWindow
  167.         .wShowWindow = intWinStyle
  168.     End With
  169.     'Start the shelled application:
  170.     Call CreateProcessA(lpApplicationName:=0&, _
  171.                         lpCommandLine:=strCommand, _
  172.                         lpProcessAttributes:=0&, _
  173.                         lpThreadAttributes:=0&, _
  174.                         bInheritHandles:=1&, _
  175.                         dwCreationFlags:=conNormalPriority, _
  176.                         lpEnvironment:=0&, _
  177.                         lpCurrentDirectory:=0&, _
  178.                         lpStartupInfo:=objStart, _
  179.                         lpProcessInformation:=objProcInfo)
  180.     'Wait for the shelled application to finish
  181.     Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
  182.                              dwMilliseconds:=conInfinite)
  183.     Call CloseHandle(hObject:=objProcInfo.hProc)
  184. End Sub
  185.  
  186. Public Function DBWindowVisible() As Boolean
  187.     Dim hWnd As Long, lngStyle As Long
  188.  
  189.     'Get handle of MDIClient window of current application
  190.     hWnd = FindWindowEx(hWndAccessApp, 0, "MDIClient", vbNullString)
  191.     'Within that, find child window matching class Odb (database window)
  192.     hWnd = FindWindowEx(hWnd, 0, "Odb", vbNullString)
  193.     'Default result to False in case handle wasn't found
  194.     DBWindowVisible = False
  195.     If (hWnd) Then
  196.         'Having found window, check the visibility flag of its style value
  197.         lngStyle = GetWindowLong(hWnd, conGWLStyle)
  198.         DBWindowVisible = ((lngStyle And conWinVis) = conWinVis)
  199.     End If
  200. End Function
  201.  
  202. 'AppWindowState() returns and/or sets the app's window state.
  203. Public Function AppWindowState(appVar As Application, _
  204.                                Optional strSet As String = "Read") As String
  205.     Dim blnVisible As Boolean
  206.  
  207.     With appVar
  208.         AppWindowState = "Restore"
  209.         If IsMaximised(.hWndAccessApp) Then AppWindowState = "Maximise"
  210.         If IsMinimised(.hWndAccessApp) Then AppWindowState = "Minimise"
  211.         If strSet = "Read" Then Exit Function
  212.         If strSet <> AppWindowState Then
  213.             blnVisible = .Visible
  214.             If Not blnVisible Then .Visible = True
  215.             Select Case strSet
  216.             Case "Maximise"
  217.                 Call .RunCommand(acCmdAppMaximize)
  218.             Case "Minimise"
  219.                 Call .RunCommand(acCmdAppMinimize)
  220.             Case "Restore"
  221.                 Call .RunCommand(acCmdAppRestore)
  222.             End Select
  223.             If Not blnVisible Then .Visible = False
  224.         End If
  225.     End With
  226. End Function
  227.  
  228. 'GetLogonName() determines the logon ID of the current user.
  229. Public Function GetLogonName() As String
  230.     Dim lngMax As Long
  231.     Dim strBuffer As String
  232.  
  233.     lngMax = &HFF
  234.     strBuffer = String(lngMax, vbNullChar)
  235.     Call GetUserName(lpBuffer:=strBuffer, lpnSize:=lngMax)
  236.     GetLogonName = Trim(Left(strBuffer, lngMax - 1))
  237. End Function
  238.  
  239. 'GetUserObject() returns an IADs object representing either the LDAP: string
  240. '  if passed, or the logged-on user otherwise.
  241. Public Function GetUserObject(Optional ByVal strDN As String = "") As Object
  242.     On Error Resume Next
  243.     'If incorrect strDN passed then returned value will be a Nothing.
  244.     If strDN > "" Then
  245.         Set GetUserObject = GetObject("LDAP://" & strDN)
  246.     Else
  247.         strDN = "LDAP://OU=MyBusiness," & _
  248.                 GetObject("LDAP://RootDSE").Get("rootDomainNamingContext")
  249.         Set GetUserObject = ProcessIAD(GetObject(strDN), GetLogonName())
  250.     End If
  251. End Function
  252.  
  253. 'ProcessIAD() is called recursively and returns an object only when it is a user
  254. '  that matches strUser.
  255. Private Function ProcessIAD(ByRef iadVar As Object, strUser As String) As Object
  256.     Dim iadWork As Object
  257.  
  258.     With iadVar
  259.         Select Case IADType(iadVar)
  260.         Case "User"
  261.             If .sAMAccountName = strUser Then Set ProcessIAD = iadVar
  262.             Exit Function
  263.         Case "organizationalUnit"
  264.             For Each iadWork In iadVar
  265.                 Set ProcessIAD = ProcessIAD(iadWork, strUser)
  266.                 If Not ProcessIAD Is Nothing Then Exit Function
  267.             Next iadWork
  268.         End Select
  269.     End With
  270. End Function
  271.  
  272. 'IADType() returns whether the IAD should be treated as a container
  273. '  (organizationalUnit), a user (user), or simply ignored (group).
  274. Private Function IADType(iadVar As Object) As String
  275.     Dim varWork As Variant
  276.  
  277.     With iadVar
  278.         Call .GetInfo
  279.         For Each varWork In .Get("objectClass")
  280.             Select Case varWork
  281.             Case "user", "group", "organizationalUnit"
  282.                 IADType = varWork
  283.                 Exit For
  284.             End Select
  285.         Next varWork
  286.     End With
  287. End Function
  288.  
  289. 'ShowIADs() shows all users, groups and containers of the AD from strRoot.
  290. Public Sub ShowIADs(Optional ByRef iadVar As Object, _
  291.                     Optional ByVal strRoot As String = "")
  292.     Dim iadWork As Object
  293.     Dim strWork As String
  294.  
  295.     If iadVar Is Nothing Then
  296.         strWork = "LDAP://" & _
  297.                   strRoot & _
  298.                   "OU=MyBusiness," & _
  299.                   GetObject("LDAP://RootDSE").Get("rootDomainNamingContext")
  300.         Set iadVar = GetObject(strWork)
  301.     End If
  302.     With iadVar
  303.         strWork = IADType(iadVar)
  304.         If strWork > "" Then
  305.             Debug.Print strWork & "," & _
  306.                         IIf(strWork = "user", .sAMAccountName, "") & "#" & _
  307.                         .distinguishedName & "~";
  308.         End If
  309.         Select Case strWork
  310.         Case "user"
  311.             Exit Sub
  312.         Case "organizationalUnit"
  313.             For Each iadWork In iadVar
  314.                 Call ShowIADs(iadWork)
  315.             Next iadWork
  316.         End Select
  317.     End With
  318. End Sub
Mar 10 '14 #2

100+
P: 104
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?
Mar 11 '14 #3

NeoPa
Expert Mod 15k+
P: 31,494
The only time a "-" appears is when the value is negative, but let's deal with the other two which are less clear :
  1. &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.
  2. & --> as a suffix means that the literal value preceeding it is of type Long.
Mar 11 '14 #4

Post your reply

Sign in to post your reply or Sign up for a free account.