Access Application, Hidden Application Window With Form Taskbar Icon - vba

I have an access application with one main form. When you open the application, an AutoExec macro hides the application via the Windows API apiShowWindow. Then, the AutoExec opens up the main form which is set to Popup. This all works beautifully; my database guts are hidden and the form opens up and just floats along.
However, when the access database gets hidden, you loose the taskbar icon. I have a custom icon set in the Options\Current Database\Application Icon setting. If I don't hide the database, this icon displays just fine in the task bar.
I found an API workaround that will show an icon in the taskbar for just the form. It goes a little something like this:
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Sub AppTasklist(frmHwnd)
Dim WStyle As Long
Dim Result As Long
WStyle = GetWindowLong(frmHwnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(frmHwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLong(frmHwnd, GWL_EXSTYLE, WStyle)
Debug.Print Result
Result = SetWindowPos(frmHwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub
This approach does work; I get an icon in the taskbar dedicated to just the form. However, the icon in the taskbar is the standard Access icon.
In response to this problem, I added another API call using the SendMessageA:
Public Declare Function SendMessage32 Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam
As Long, ByVal lParam As Long) As Long
Executed thus:
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
Dim icoPth As String: icoPth = CurrentProject.Path & "\MyAppIcon.ico"
Dim NewIco As Long: NewIco = ExtractIcon32(0, icoPth, 0)
Dim frmHwnd As Long: frmHwnd = Me.hwnd 'the form's handle
SendMessage32 frmHwnd, WM_SETICON, ICON_SMALL, NewIco
SendMessage32 frmHwnd, WM_SETICON, ICON_BIG, NewIco
SendMessage32 hWndAccessApp, WM_SETICON, ICON_SMALL, NewIco
SendMessage32 hWndAccessApp, WM_SETICON, ICON_BIG, NewIco
Keep in mind that I have tried the above four lines of 'SendMessages' in various orders inside of and outside of, top of and bottom of the AppTasklist Sub to no avail.
It does appear to work at the application level, but it never seems to work at the form level.
For those of you familiar with this particular predicament, let me list some of the other options outside of VBA that I have tried.
1.) Taskbar\Properties\Taskbar buttons. I've changed this menu option to 'Never Combine' and 'Combine When Taskbar Is Full'. So, basically, this does work; I now get my icon for just the folder and the little label. BUT(!), it only works if the users have these settings checked on their end. In my experience, almost no one uses any of the options except 'Always combine, hide labels'.
2.) Changing the Registry settings. You can change the following registry key to change the default icon an application uses: "HKEY_CLASSES_ROOT\Access.Application.14\DefaultIcon(Default)." However, most users (myself included) don't have access to the HKEY_CLASSES_ROOT part of the registry. Furthermore, I would have to write some code to find the proper key and then change it (which I could do) but, it's unclear if this change would be immediate--not to mention I'd have to change it back when exiting the application.
3.) Right-clicking the pinned application, then right clicking the application in the menu does give you a properties menu with a button called 'Change Icon...' in the 'Shortcut' tab. However, for a program like Access, this button is greyed out.
I am using Windows 7 and Access 2010.
Is it possible to force the Taskbar Icon in the above scenario to something other than the standard Access Icon?
I feel like there's ether a little something I'm missing, or an API function that could be used, or a better SendMessage constant, or that, maybe, it just can't be done.
Any help would be greatly appreciated.
Also, as a disclaimer (I guess): obviously the above code was pulled from other posts from this forum and others. Most of it was unattributed from whence I got it. I've made some minor tweeks to make it work in Access as opposed to that other piece of Microsoft Software that keeps getting in my search results so I will not name it here.
Thanks!

Okay. So I'm going to answer my own question. Apparently all I really needed was a break from the action and to type out my problem. A short time after I posted the question, I got back on the horse and tried some more search terms. I eventually came across a post which really didn't seem fruitfull at the outset because it wasn't clear to me if the poster and myself were dealing with the same scenario.
I found my answer here:
http://www.access-programmers.co.uk/forums/showthread.php?t=231422
First off, your application must open via a shortcut. Fortunately for me, I've been using a Desktop shortcut from the begining.
When I started building the application, I knew from the outset that I would be using a VBScript to do the installation of the application (as well as updating when a newer version get's released). In that script, I create a Desktop shortcut to the application which I store in the user's Documents directory. I also store the application icon in that directory which I attach to the application shortcut.
If you've never created a shortcut via vba/script, you'll essentially do something like this (written in vbScript):
Dim WinShell
Dim ShtCut
Set WinShell = CreateObject("WScript.Shell")
Set ShtCut = WinShell.CreateShortcut(strDesktopPath & "\MyCoolApp.lnk")
With ShtCut
.TargetPath = (See below)
.Arguments = (See below)
.IconLocation = ...
.Desciption = "This is the coolest app, yo!"
.WorkingDirectory = strAppPath
.WindowStyle = 1
.Save
End With
Now, the target of the shortcut started out being something like this:
"C:\Users\UserName\Public\Documents\MyCoolApp\MyCoolApp.accdb"
Obviously your users may have a different enterprise structure for the Documents location...
What the above reference post suggests doing is turning that shortcut into a psuedo command line script.
To do this:
First, your actual target is going to be the path to the user's version of access (Runtime or full), like such:
"C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE"
IMPORTANT! You will have to wrap this target in double-quotes, i.e.:
.TargetPath = Chr(34) & strAccessPath & Chr(34)
Next (and you won't find this in the above post, I had to figure it out), you'll need to set the Argument to the directory of the application, like such:
"C:\Users\UserName\Public\Documents\MyCoolApp\MyCoolApp.accdb"
IMPORTANT! Again, you'll have to wrap the arguments in double-quotes, i.e.:
.Arguments = Chr(34) & strAppPath & Chr(34)
Also important, I hope your app IS cool.
Once you have this shortcut set up, essentially you're making it so your application will have it's own workgroup on the taskbar. I.e., if Access is open in general, your application will have it's own group on the taskbar. This group will have your cool, custom icon associated with it. And as a huge unexpected bonus, you'll be able to pin your shortcut to the taskbar outside of Access. SWEEEEEET!
Good luck!

Related

How to set a windows explorer window as the active window

I'm trying to get a macro to select or activate a windows explorer window after it has completed or open the window if it is not found. Currently it does find the window handle (saved as "window") when it is open but it will not activate that window!
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal hWnd As Long) As Long
Dim directory As String
directory = "C:\...\practice contracts\"
Dim directorySplit() As String
directorySplit = Split(directory, "\")
'--the rest of the macro--
Dim window As Long
window = FindWindow("CabinetWClass", directorySplit(UBound(directorySplit) - 1))
If window <> 0 Then
BringWindowToTop window
Else
Shell "explorer.exe " & directory, vbNormalFocus
End If
I've also tried AppActivate directorySplit(UBound(directorySplit) - 1) instead of FindWindow but it also will find but not activate the window. I can tell that it finds the window and its handle because if I close the explorer window and try running AppActivate againt, it will raise an error instead.
Any help would be appreciated.
Can you please try this?
It worked for me in both conditions. Just tried it again.
If it errors out on appactivate because it cannot find the window, it goes to the window open section and opens the folder.
On Error GoTo WindowOpen
AppActivate directorySplit(UBound(directorySplit) - 1)
Exit Sub
WindowOpen:
Shell "explorer.exe " & directory, vbNormalFocus
This is another solution - simply try to close the window if it exists and then call the same window from the Shell:
If Window <> 0 Then Windows(Window).Close
Shell "explorer.exe " & directory, vbNormalFocus
It should work quite robustly and you can change the focus easily through VBA.

how to get excel to play a sound when a condition is met

I have a spreadsheet for scanning in serial numbers and asset tags.
2 Columns and a barcode scanner. I have setup conditional formatting so if any cell gets a duplicate entry in the set range it changes the font and cell color so its obvious a mistake was made.
I would like to play a sound when an error occurs to stop the need to keep looking back at the pc to see if a duplicate has been found.
I have found numerous ways to play a sound if a cell is a certain value but not if excels conditional formatting is applied.
Any suggestions would be appreciated.
#If Win64 Then
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Function SoundMe() As String
'Updateby Extendoffice 20161223
Call PlaySound("c:\windows\media\Speech On.wav", _
0, SND_ASYNC Or SND_FILENAME)
SoundMe = ""
End Function
and after the vb code
Then save and close this code window, return to the worksheet, and enter this formula: =IF(A1>300,SoundMe(),"")into a blank cell beside the cell contains the value you want to play a sound based on, and then press Enter key, nothing will be displayed into the formula cell, see screenshot:
this works fine if a number is greater than or equals another I cant think how to get it to pick up a duplicate, Im very new to excel formulas.
Thankyou for any tips.
Here is the code with the condition blnWannaHearDespasito = True. And the music is Despasito. :)
Option Explicit
Public Sub TestMe()
Dim blnWannaHearDespasito As Boolean
blnWannaHearDespasito = True
If blnWannaHearDespasito Then
Application.Speech.Speak "Despasitoooooo"
Else
Application.Speech.Speak ("No")
End If
End Sub
The If blnWannaHearDespasito Then is the same as If blnWannaHearDespasito = True Then, but it is shorter. The If is always evaluated to True or False.
Speech.Speak Method in MSDN.
I do something similar, I enter in serial numbers and duplicates are an absolute no-no. Best way I've found to do this is to highlight the column that is being scanned into, go to data>data validation under settings select allow to custom then enter this formula
=COUNTIF($F$2:$F$65536, F2)=1 where theres an F in the formula change that to the column letter that you are applying this to for example if scanning into A column then the formula would read =COUNTIF($A$2:$A$65536, A2)=1
then when that is settled while still with the data validation window open click on the error alert tab, here you can set a custom message and alert.
such as
Serial number already scanned!
This serial number has already been scanned into the system, please re-check the serial number and re-scan.
Not only will it pop up with an error when it finds a duplicate but will also play an audible default windows sound.

Identify icon overlay in VBA

I'm on a quest to figure out how to identify different icon overlays through Excel VBA.
There is a cloud syncing software and I am trying to identify whenever the syncing of my excel file has finished or still in progress. I was able to achieve a basic level of reliability by following the modification date of some meta(?) files but there is not enough consistency to fully rely on this method.
The result of my searches is a big punch in the face, since there is not much info about it in VBA. Basically all I have found that everyone uses advanced languages like C++ to handle these things.
The closest source I've got in VBA does something similar with the System Tray and uses the shell32.dll calling the appropiate windows api (link). But I have no idea how to make it to the Shell Icon Overlay Identifier.
What do you guys think, is there a possible way to make it through VBA or I have to learn C++?
Awesome! It is possible! The SHGetFileInfo method works!
It gives me values according to the current overlays. Here is the code for any other crazy people who wanna mess around with it:
Const SHGFI_ICON = &H100
Const SHGFI_OVERLAYINDEX = &H40
Const MAX_PATH = 260
Const SYNCED = 100664316 'own specific value
Const UNDSYNC = 117442532 'own specific value
Private Type SHFILEINFO
hIcon As Long 'icon
iIcon As Long 'icon index
dwAttributes As Long 'SFGAO_ flags
szDisplayName As String * MAX_PATH 'display name (or path)
szTypeName As String * 80 'type name
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Sub GetThatInfo()
Dim FI As SHFILEINFO
SHGetFileInfo "E:\Test.xlsm", 0, FI, Len(FI), SHGFI_ICON Or SHGFI_OVERLAYINDEX
Select Case FI.iIcon
Case SYNCED
Debug.Print "Synchronized"
Case UNDSYNC
Debug.Print "Synchronization in progress"
Case Else
Debug.Print "Some shady stuff is going on!"
End Select
End Sub
Thanks for the tip again!

How to run function in vba using data macro?

i am new to data macro in ms access 2013 and need some help with it.
so lets assume that i have a simple database with only one table of Users.
when i change the "Age" Field in the table, i want to run an external exe file (the reason why dosent matter).
so i learn the subject during the last few days and end up with this:
1. i build a module in ms access called RunMiniFix (MiniFix is the name of the exe file i want to run). the module uses ShellExecute function and the whole module looks like that:
Option Compare Database
Const SW_SHOW = 1
Const SW_SHOWMAXIMIZED = 3
Public 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, _
Optional ByVal nShowCmd As Long) As Long
Public Function RunMiniFix()
Dim RetVal As Long
On Error Resume Next
RetVal = ShellExecute(0, "open", "C:\Program Files\MiniFix\MiniFix.exe", "<arguments>", _
"<run in folder>", SW_SHOWMAXIMIZED)
End Function
Now, when activating the module, everything works just fine and the exe file is running.
in ms access, i build a data macro based on an 'If Then' statement, asking
if [Users]![Age] > x and then calls the build-in RunCode event from the action catalog which calls the RunMiniFix function.
Now, when saving the data macro, the ms access pops up a message box saying Microsoft access dosen't have the ability to find the name "Users" i mentioned in the phrase and recommend me to look for the right control in the form. "the form"? yes, the form!
this database is not form based. i have no gui designed what so ever. i have no buttons or click event to handle.
what i am asking is how can i trigger the RunMiniFix module when the Age field is modify. please, this is very important!
thanks a head,
oron.
Please use SetLocalVar from the action list in data macro and set the expression to name of your function. Sample:
name: "test"
Expression: RunMiniFix()

Download / Save file from Web Site / Web Page

I need to download the PDF files from the link below for the first/top 5 dates and save them on Desktop for instance. I have no clue how to start but also couldn't find something explicit on Google.
Do you think you can help me?
http://cetatenie.just.ro/ordine/articol-11/
I would use Internet Explorer, and automate it using an SHDocVw.InternetExplorer object (VBA reference 'Microsoft Internet Controls', ieframe.dll).
You can either (a) create a new Internet Explorer window using Set x = New SHDocVw.InternetExplorer or (b) acquire an existing Internet Explorer window using Set owins = CreateObject("Shell.Application").Windows (owins is an array, loop through it until you find one where Mid(TypeName(owins(i).Document), 1, 12) = "HTMLDocument").
Once you have an Internet Explorer ie, you can call ie.Navigate(url) to go to a website.
To wait for Internet Explorer to finish navigating before you interrogate it, you can run something like:
Do While mascot_win.Busy
Application.Wait DateAdd("s", 1, Now)
DoEvents
Loop
To get the URLs for the first five PDFs on that page, you'd need to examine the HTML of the page. There are two ways, depending on how well-formed the HTML is. If the HTML is well-written, then you can navigate the Document Object Model (the tags, like XML) with ie.Document.all(). But if the HTML is not well-formed, you may have to resort to reading the HTML from ie.Document.all(0).innerHTML.
By the looks of the link you gave, you will be looking for things like:
<li>Data de <strong>22.03.2013</strong>, numarul: 149P</li>
Once you have isolated each PDF URL (using either the attribute of the <a> tag in the DOM model or using lots of Mid() calls on the HTML), you can download it using:
Private Declare Function URLDownloadToFile _
Lib "urlmon" _
Alias "URLDownloadToFileA" _
( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
Dim ss As String
Dim ts As String
ss = "http://blah/blah/blah.pdf"
ts = "c:\meh\blah.pdf"
URLDownloadToFile 0, ss, ts, 0, 0