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!
Related
I need to do a one time download of a pipe deliminated text file in VBA. I have tried many of the solutions in other stack overflow questions but I can't seem to make any of the solutions work. It's from the internal wiki page of my firm.
The file is something like: https://wiki.somecompany/downloads/attachments/data.txt
Note: that is not a real url
Edit: I am working within excel.
I am extremely new to VBA, so the solutions I read will probably work but they were not idiot proof.
I tried many things, but the most promising looking were the solutions posted here: EXCEL VBA - To open a text file from a website
I stopped working with the first one because it seemed like you needed Mozilla for that one, and I did not know how to specify Chrome.
I messed around with the open workbook option, but I kept getting a compile error that said "Expected: =" but I don't know what the problem is or where it should be.
Edited: #Tim Williams - your solution is the closest to have anything at all happen besides just VBA errors. I got as far as turning my spreadsheet into a log in page, so I guess I need to pass a username and password somehow
You should be able to turn on the Macro Recorder and get what you want pretty quickly. In fact, you probably spent 10x more time describing the scenario, then it would take to record the code you need. Although, it is possible that you actually can't import the data using the Macro Recorder. You should still be able to import the data by referencing a CSV, which I believe is the exact same thing as a Text file.
Sub Import_CSV_File_From_URL()
Dim URL As String
Dim destCell As Range
URL = "http://www.test.com/test.csv"
Set destCell = Worksheets("test").Range("A1")
With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & URL, Destination:=destCell)
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
destCell.Parent.QueryTables(1).Delete
End Sub
If that doesn't work for you, simply download the file, and do the import from your hard-drive.
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
Sub DownloadFilefromWeb()
Dim strSavePath As String
Dim URL As String, ext As String
Dim buf, ret As Long
URL = Worksheets("Sheet1").Range("A2").Value
buf = Split(URL, ".")
ext = buf(UBound(buf))
strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If ret = 0 Then
MsgBox "Download has been succeed!"
Else
MsgBox "Error"
End If
End Sub
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.
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()
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!
Premise: Copying files from Linux to Windows over FTP using WinInet FtpGetFile.
Objective: The files originate as ANSI and are needed in Unicode.
Progress:
The only issue I am having is that I need LF characters from the original file to be CRLF characters in the destination file.
I have tried:
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileW" (ByVal hFTP As Long, ByVal sRemoteFile As String, ByVal sNewFile As String, ByVal bFailIfExists As Boolean, ByVal lFlagsAndAttributes As Long, ByVal lFlags As Long, ByVal lContext As Long) As Boolean
Public Sub test(hConn as Long, strSrcPath as String, strDestPath as String)
'All code works other than the file not converting to having CR chars
ftpGetFile(hConn, StrConv(strSrcPath, vbUnicode), StrConv(strDestPath, vbUnicode), True, 0, 0, 0)
End Sub
(FAILS to convert) using the Unicode version of the FtpGetFile method (Alias FtpGetFileW), passing the arguments using StrConv(<string>, vbUnicode). The files show up with only LF chars at the end of the lines.
(WORKS, manually) copying files manually using WinSCP. It automatically makes the output files Unicode but I can't find the method/settings associated with this. I cannot use the WinSCP.dll at my work as I cannot register it.
(WORKS, slowly) using a work-around. using the either version of the FtpGetFile. Opening file, reading to variable, closing file and then opening file for write, writing Replace(variable,Chr(10),Chr(13)&Chr(10)). Also, files appear to ~double in size.
How do I get a file using the WinAPI functions and have it convert in one shot (if possible)?
Related articles:
Unicode turns ANSI after FTP transfer
Writing ANSI string to Unicode file over FTP
Source Info:
How to Create FTP Components CodeGuru
MSDN for WinInet
The following appears to be working near instantaneously. If anyone has any better suggestions on how to automate this (preferably without this work-around or to make my work-around better) please provide them. Otherwise, I'll probably be choosing this as the answer in a few days. ftpReadFile is a custom function that uses InternetReadFile and spits out the entire file as a string.
Public Function ftpGetFileToUnicode(hConn As Long, strFromPath As String, strDestPath As String) As Boolean
Dim hFile As Long
Dim objFS As New FileSystemObject, objFile As TextStream
If Not objFS.FileExists(strDestPath) Then
Set objFile = objFS.CreateTextFile(strDestPath, ForWriting)
objFile.Write Replace(ftpReadFile(hConn, strFromPath), Chr(10), Chr(13) & Chr(10))
objFile.Close
If objFS.GetFile(strDestPath).Size > 0 Then
ftpGetFileToUnicode = True
Exit Function
End If
End If
ftpGetFileToUnicode = False
End Function
Note: Creates a 0 byte file if the file doesn't exist. Can easily be changed to not do that.
Disclaimer: I know nothing about VB. But FtpGetFile says it supports ASCII mode transfers, which have implicit line ending conversion:
ftpGetFile(hConn, StrConv(strSrcPath, vbUnicode), StrConv(strDestPath, vbUnicode),
True, 0, FTP_TRANSFER_TYPE_ASCII, 0)