How to show Windows 10 notification toast from VBA - vba

I'd like to know the easiest way to show notification toast in windows 10 from VBA.
I didn't found a good answer to this. I found a really simple way to create notifications from PowerShell here. But I can't get it to work from VBA because I didn't find a way to execute this in one line using WScript.Shell.
I tried several ways to accomplish that but i didn't succeed. Below you can find my last attempt:
Public Sub Notify_Test()
Dim WsShell As Object: Set WsShell = CreateObject("WScript.Shell")
Dim strCommand As String
strCommand = """powershell.exe"" ^ "
strCommand = strCommand & "[reflection.assembly]::loadwithpartialname(""System.Windows.Forms"")"
strCommand = strCommand & "; [reflection.assembly]::loadwithpartialname(""System.Drawing"")"
strCommand = strCommand & "; $notify = new-object system.windows.forms.notifyicon"
strCommand = strCommand & "; $notify.icon = [System.Drawing.SystemIcons]::Information"
strCommand = strCommand & "; $notify.visible = $true"
strCommand = strCommand & "; $notify.showballoontip(10,""New Chat!"",""You have received New Chat!"",[system.windows.forms.tooltipicon]::None)"
WsShell.Run strCommand
End Sub
I'd like to avoid writing a .ps1 file. Can someone please help me with this question?
Thank you in advance!
UPDATE:
Thanks to #Remko I was able to display the notification.
I did a function to make its use simpler:
Public Function Notify(ByVal title As String, ByVal msg As String, _
Optional ByVal notification_icon As String = "Info", _
Optional ByVal app As String = "excel", _
Optional ByVal duration As Integer = 10)
'Parameters:
' title (str):Notification title
' msg (str):Notification message
' notification_icon (str):Notification icon. Available options are: Info, Error and Warning
' app (str):Process name of app you want to be display in the system tray icon
' duration (int):Duration of notification in seconds
Const PSpath As String = "powershell.exe"
Dim WsShell As Object: Set WsShell = CreateObject("WScript.Shell")
Dim strCommand As String
If notification_icon <> "Info" And notification_icon <> "Error" And notification_icon <> "Warning" Then
notification_icon = "Info"
End If
strCommand = """" & PSpath & """ -Command " & Chr(34) & "& { "
strCommand = strCommand & "Add-Type -AssemblyName 'System.Windows.Forms'"
strCommand = strCommand & "; $notification = New-Object System.Windows.Forms.NotifyIcon"
strCommand = strCommand & "; $path = (Get-Process -id (get-process " & app & ").id).Path"
strCommand = strCommand & "; $notification.Icon = [System.Drawing.Icon]::ExtractAssociatedIcon($path)"
strCommand = strCommand & "; $notification.BalloonTipIcon = [System.Windows.Forms.ToolTipIcon]::" & notification_icon & ""
strCommand = strCommand & "; $notification.BalloonTipText = '" & msg & "'"
strCommand = strCommand & "; $notification.BalloonTipTitle = '" & title & "'"
strCommand = strCommand & "; $notification.Visible = $true"
strCommand = strCommand & "; $notification.ShowBalloonTip(" & duration & ")"
strCommand = strCommand & " }" & Chr(34)
WsShell.Run strCommand, 0, False
End Function
Public Sub Notify_Examples()
Notify "Insert Title Here", "Insert Your Message Here"
Notify "Insert Title Here", "Insert Your Message Here", "Warning"
Notify "Insert Title Here", "Insert Your Message Here", "Error", "outlook"
End Sub
I'd like to make and extra observation. Nothing happens when leave the PSpath = "powershell.exe". I guess this is due to the fact my user is not an admin. I was able to bypass this by copying the powershell.exe to my documents and altering the PSpath to "C:\Users\my_user\Documents\powershell.exe". Maybe this is the case for you too...

If you insist doing this with PowerShell the following code works:
Public Sub Notify_Test()
Dim WsShell As Object: Set WsShell = CreateObject("WScript.Shell")
Dim strCommand As String
strCommand = "powershell.exe -Command " & Chr(34) & "& { "
strCommand = strCommand & "[reflection.assembly]::loadwithpartialname('System.Windows.Forms')"
strCommand = strCommand & "; [reflection.assembly]::loadwithpartialname('System.Drawing')"
strCommand = strCommand & "; $notify = new-object system.windows.forms.notifyicon"
strCommand = strCommand & "; $notify.icon = [System.Drawing.SystemIcons]::Information"
strCommand = strCommand & "; $notify.visible = $true"
strCommand = strCommand & "; $notify.showballoontip(10,'New Chat!','You have received New Chat!',[system.windows.forms.tooltipicon]::None)"
strCommand = strCommand & " }" & Chr(34)
WsShell.Run strCommand
End Sub
It will of course briefly flash a console (powershell) window

Related

VBA how to check if download files from Server has success?

I'm able to use the below code to download files from server. However, this does tell me whether the files are downloaded successfully.
Sub DownloadFirstRunFilesPart2()
Application.StatusBar = "Downloading files..."
Dim wsh As Object
Dim errorcode4 As Integer
Dim cmd5 As Variant
Dim FirstRunFiles(5) As Variant
Dim var As Variant
FirstRunFiles(0) = ProN & "_KSParameter_UserInput.xlsx"
FirstRunFiles(1) = ProN & "_KSParameter_SysOutput.xlsx"
FirstRunFiles(2) = ProN & "_ModelParameter_UserInput.xlsx"
FirstRunFiles(3) = ProN & "_ModelParameter_SysOutput.xlsx"
FirstRunFiles(4) = ProN & "_VarClusParameter_UserInput.xlsx"
FirstRunFiles(5) = ProN & "_VarClusParameter_SysOutput.xlsx"
For Each var In FirstRunFiles
cmd5 = Chr(34) & "C:\Program Files (x86)" & "\PuTTY\pscp.exe" & Chr(34) & " -sftp -l " & pUser & " -pw " & pPass & _
" " & " " & pHost & ":" & ServerPath & "/" & var & " " & LocalPath & "\"
Set wsh = CreateObject("wscript.shell")
errorcode4 = wsh.Run(cmd5, vbHide)
'If errorcode4 = 0 Then MsgBox ("Error occurs. Fail to download " & var)
Next var
Application.StatusBar = "Download complete"
MsgBox ("Downloading process complete.")
End Sub
My error code always equals 0 no matter the file exists or not. How should I change this program?
Thanks in advance!
Update:
The new code that I tried:
Sub test()
Dim wsh As Object
Dim WshShellExec As Variant
Dim cmd3 As String
Dim pFirstRunFile1 As String
Const WshFinished = 1
Const WshFailed = 2
pFirstRunFile1 = "this_proj_name.txt"
cmd3 = Chr(34) & "C:\Program Files (x86)" & "\PuTTY\pscp.exe" & Chr(34) & " -sftp -l " & pUser & " -pw " & pPass & _
" " & " " & pHost & ":" & ServerPath & "/WOE/" & pFirstRunFile1 & " " & LocalPath & "\WOE"
Set wsh = CreateObject("wscript.shell")
WshShellExec = wsh.Exec(cmd3)
Select Case WshShellExec.Status
Case WshFinished
strOutput = WshShellExec.StdOut.ReadAll
Case WshFailed
strOutput = WshShellExec.StdErr.ReadAll
End Select
MsgBox strOutput 'write results in a message box
End Sub
However I'm getting error on this line:
WshShellExec = wsh.Exec(cmd3)
The error message says "Object does not support this property or method". Any ideas?

Excel OLEDB connection issue

Below is the code: What I am trying to do is made the refresh of data more under my control. So when I "GL date" from 03/31/2014 to 04/31/2014. The connection picks up the april data.
The error I am getting is With Selection.QueryTable, thats where it breaks.
The table starts at cell "A1" on the PCAP tab
Sub Update()
Call ReplaceConnectionandRefresh1("PCAP", "zzFS - PCAP- SCRF3", "Apollo", "zzFS - PCAP- SCRF3")
End Sub
Sub ReplaceConnectionandRefresh1(spreadsheet As Variant, DriverName As String, RWFolder As String, CombinedNumber As String)
Sheets(spreadsheet).Visible = True
Sheets(spreadsheet).Select
Sheets(spreadsheet).Range("A1").Select
With Selection.QueryTable
.Connection = "OLEDB;Provider=ftiRSOLEDB.RSOLEDBProvider;" _
& "Integrated Security=" & """" & """" _
& ";Location=" & dbName & ";User ID=" & """" & """" _
& ";Initial Catalog=" & dbName & ";Data Source=" & ServerName _
& ";Mode=Read;Persist Security Info=True;Extended Properties="
.MaintainConnection = False
MYCURRENTVALUE = .CommandText
End With
MYCURRENTVALUE = """" & dbName & """"
MYCURRENTVALUE = MYCURRENTVALUE & "." & """" & RWFolder & """"
MYCURRENTVALUE = MYCURRENTVALUE & "." & """" & DriverName & """"
MYCURRENTVALUE = MYCURRENTVALUE & " "
MYCURRENTVALUE = MYCURRENTVALUE & """" & "Legal Entity=" & CombinedNumber & """"
MYCURRENTVALUE = MYCURRENTVALUE & " " & """"
MYCURRENTVALUE = MYCURRENTVALUE & "GL Date=" & Format("03/31/2014", "mm/dd/yyyy") & """"
MYCURRENTVALUE = MYCURRENTVALUE & " FLAGS[/SILENT] "
With Selection.QueryTable
.CommandText = MYCURRENTVALUE
.Refresh BackgroundQuery:=False
End With
End Sub
Perhaps the range "A1" does not contain the Query table object. Also try to use Selection and Select as little as possible (Actually you will need it in very rare occasions) Rather use the actual object.
Option Explicit
Sub Update()
Call ReplaceConnectionandRefresh1("PCAP", "zzFS - PCAP- SCRF3", "Apollo", "zzFS - PCAP- SCRF3")
End Sub
Sub ReplaceConnectionandRefresh1(spreadsheet As String, _
DriverName As String, _
RWFolder As String, _
CombinedNumber As String)
Dim oQueryTable As QueryTable
Dim strConnnection As String
Dim strCommand As String
' Grab the query Table from the sheet. I am grabbing the first one
' adjust if there is more.
Set oQueryTable = Sheets(spreadsheet).QueryTables(1)
Sheets(spreadsheet).Visible = True
Sheets(spreadsheet).Select
Sheets(spreadsheet).Range("A1").Select
' Create connection string
strConnnection = "OLEDB;Provider=ftiRSOLEDB.RSOLEDBProvider;" _
& "Integrated Security=" & """" & """" _
& ";Location=" & dbName & ";User ID=" & """" & """" _
& ";Initial Catalog=" & dbName & ";Data Source=" & ServerName _
& ";Mode=Read;Persist Security Info=True;Extended Properties="
'Create connection command
strCommand = """" & dbName & """"
strCommand = strCommand & "." & """" & RWFolder & """"
strCommand = strCommand & "." & """" & DriverName & """"
strCommand = strCommand & " "
strCommand = strCommand & """" & "Legal Entity=" & CombinedNumber & """"
strCommand = strCommand & " " & """"
strCommand = strCommand & "GL Date=" & Format("03/31/2014", "mm/dd/yyyy") & """"
strCommand = strCommand & " FLAGS[/SILENT] "
' Actually update the connection.
With oQueryTable
.Connection = strConnnection
.MaintainConnection = False
.CommandText = strCommand
.Refresh BackgroundQuery:=False
End With
End Sub
Also note that there is a variable "dbName" that is not declared or passed as argument.
I hope this helps :)

Variable from VBA to VBScript

I am working on VBA, from which I have to call a vbscript by passing some values.
Here is the code:
''VBA
'Below values are on different cells of Excel file which I am reading
'into a global variable then pass it to vbscript.
'SFilename = VBscript file path
'QClogin = "abc"
'QCpassword = "abc"
'sDomain = "xyz"
'sProject = "xyz123"
'testPathALM = "Subject\xyz - Use it!\xyz_abc"
'QCurl = "http://xxx_yyy_zzz/qcbin/"
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript " & SFilename & " " & QClogin & _
" " & "" & QCpassword & " " & "" & sDomain & " " & "" & sProject & _
" " & "" & testPathALM & " " & "" & QCurl & "")
''VBscript on some location
Dim strUserName, strPassword, strServer
strUserName = WScript.Arguments(0) '"abc"
Msgbox "strUserName : " & strUserName
strPassword = WScript.Arguments(1) '"abc"
Msgbox "strPassword : " & strPassword
strServer = WScript.Arguments(5) '"http://xxx_yyy_zzz/qcbin/"
Msgbox "strServer : " & strServer
Dim strDomain, strProject, strRootNode
strDomain = WScript.Arguments(2) '"xyz"
Msgbox "strDomain: " & strDomain
strProject = WScript.Arguments(3) '"xyz123"
Msgbox "strProject: " & strProject
strRootNode = WScript.Arguments(4) '"Subject\xyz - Use it!\xyz_abc"
Msgbox "strRootNode: " & strRootNode
Now, when I running the code, it is passing below values properly to vbscript:
QClogin = "abc"
QCpassword = "abc"
sDomain = "xyz"
sProject = "xyz123"
It is having issues with these:
testPathALM = "Subject\xyz - Use it!\xyz_abc"
QCurl = "http://xxx_yyy_zzz/qcbin/"
Now, wierd thing for me is, if I keep a cell empty for "testPathALM" which is having "Subject\xyz - Use it!\xyz_abc" as value, I am getting "QCurl" value properly in vbscript.
But, if I keep value "Subject\xyz - Use it!\xyz_abc" for "testPathALM", then I am getting "-" for strServer which suppose to be "QCurl" value and "Subject\xyz" for "strRootNode" which supposed to be "Subject\xyz - Use it!\xyz_abc".
I am unable to understand what is the issue here.
Thanks a ton in advance.
Safer to quote all of your parameters:
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript """ & SFilename & """ """ & _
QClogin & """ """ & QCpassword & """ """ & _
sDomain & """ """ & sProject & """ """ & _
testPathALM & """ """ & QCurl & """")
Try a debug.print to make sure it looks as it should...

Send mail using VB Script?

I have the following code to monitor a drive. Now I an getting Echo for each file creation or deletion event.
Is there and way to modify the WScript.Echo to send a mail notification?
strDrive = "c"
arrFolders(0) = strDrive & "\\\\"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
'Loop throught the array of folders setting up the monitor for Each
i = 0
For Each strFolder In arrFolders
'Create the event sink
strCommand = "Set EventSink" & i & " = WScript.CreateObject" & "(""WbemScripting.SWbemSink"", ""SINK" & i & "_"")"
ExecuteGlobal strCommand
'Setup Notification
strQuery = "SELECT * FROM __InstanceOperationEvent WITHIN 1 " & "WHERE Targetinstance ISA 'CIM_DirectoryContainsFile'" & " and TargetInstance.GroupComponent = " & "'Win32_Directory.Name=""" & strFolder & """'"
strCommand = "objWMIservice.ExecNotificationQueryAsync EventSink" & i & ", strQuery"
ExecuteGlobal strCommand
'Create the OnObjectReady Sub
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & VbCrLf & vbTab & "Wscript.Echo objObject.TargetInstance.PartComponent" & VbCrLf & "End Sub"
WScript.Echo strCommand
ExecuteGlobal strCommand
i = i + 1
Next
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Instead of Echoing like below:
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & VbCrLf & vbTab & "Wscript.Echo objObject.TargetInstance.PartComponent" & VbCrLf & "End Sub"
I want to send a mail like this:
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & VbCrLf & vbTab & "
Set outobj = CreateObject("Outlook.Application")
Set mailobj = outobj.CreateItem(0)
With mailobj
.To = toAddress
.Subject = Subject
.HTMLBody = strHTML
.Send
End With
" & VbCrLf & "End Sub"
Is it possible or is there an other way to do this..?
I don't know what server do you use, but on Windows 2003 and 2008 e.g. you can use CDO object to create a email. You might use a smart host to send your email to.
Check this link: http://www.paulsadowski.com/wsh/cdo.htm
Also you can choose any free email component to create a email and use a smtp server to send your email. Or check this side where you can use a component including many examples how to do it: http://www.chilkatsoft.com/email-activex.asp.
** UPDATED **
This Script checks and send a email as you requestted:
strDrive = "d:"
Dim arrFolders(0) : arrFolders(0) = strDrive & "\\\\"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
'Loop throught the array of folders setting up the monitor for Each
i = 0
For Each strFolder In arrFolders
'Create the event sink
WScript.Echo "setup for folder: " & strFolder & vbLf
strCommand = "Set EventSink" & i & " = WScript.CreateObject" & "(""WbemScripting.SWbemSink"", ""SINK" & i & "_"")"
ExecuteGlobal strCommand
'Setup Notification
strQuery = "SELECT * " _
& "FROM __InstanceOperationEvent " _
& "WITHIN 1 " _
& "WHERE Targetinstance ISA 'CIM_DirectoryContainsFile'" _
& " AND TargetInstance.GroupComponent = " & "'Win32_Directory.Name=""" & strFolder & """'"
strCommand = "objWMIservice.ExecNotificationQueryAsync EventSink" & i & ", strQuery"
ExecuteGlobal strCommand
'Create the OnObjectReady Sub
strCommand = "Sub SINK" & i & "_OnObjectReady(objObject, " & "objAsyncContext)" & vbLf _
& " Wscript.Echo objObject.TargetInstance.PartComponent" & vbLf _
& " SendMail(objObject.TargetInstance.PartComponent)" & vbLf _
& "End Sub"
'WScript.Echo strCommand
ExecuteGlobal strCommand
i = i + 1
Next
WScript.Echo "Waiting for events..."
i = 0
While (True)
Wscript.Sleep(1000)
Wend
Function SendMail(vBody)
Dim oMail : Set oMail = CreateObject("CDO.Message")
'Name or IP of Remote SMTP Server
oMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "your.smtp.server"
oMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
oMail.Configuration.Fields.Update
oMail.Subject = "Email Watch Info Message"
oMail.From = "alert#yourdomain.net"
oMail.To = "target#yourdomain.net"
oMail.TextBody = vBody
oMail.Send
End Function
Correct the settings in the send mail function and your are fine.
In theory, the VBSendMail DLL should be able to do what you want.

How can I encrypt the output of mysqldump using VB.NET?

I use this code to create dump files of my database.
Now what I want, if possible, is to encrypt it so that when it is viewed in notepad or anything similar, average users cannot read it.
Call isDirectoryExist()
Call createDbBackupName()
Dim myProcess As Process = New Process
Dim strUser As String = "superadmin"
' MsgBox(" --host=localhost --user='" & strUser & "' --password """ & strDbName & """ -r """ & strPath & newDBName & """ ")
Process.Start("C:/MySQL/bin/mysqldump.exe", " --host=localhost --user='" & strUser & "' --password=1234 """ & strDbName & """ -r """ & strPath & newDBName & """ ")
I also have an option to restore these files. using these codes.
Dim strm As System.IO.Stream
strm = ofpSQL.OpenFile
txtRestore.Text = ofpSQL.FileName.ToString
If Not (strm Is Nothing) Then
Dim dbToRestore As String = ofpSQL.FileName.ToString
Dim myProcess As New Process()
myProcess.StartInfo.FileName = "cmd.exe"
myProcess.StartInfo.UseShellExecute = False
myProcess.StartInfo.WorkingDirectory = "C:\MySQL\bin\"
myProcess.StartInfo.RedirectStandardInput = True
myProcess.StartInfo.RedirectStandardOutput = True
myProcess.Start()
Dim myStreamWriter As StreamWriter = myProcess.StandardInput
Dim mystreamreader As StreamReader = myProcess.StandardOutput
myStreamWriter.WriteLine("mysql -u superadmin --password=1234 """ & strDbName & """ < """ & ofpSQL.FileName.ToString & """ ")
myStreamWriter.Close()
myProcess.WaitForExit()
myProcess.Close()
strm.Close()
End If
Of course, if it encrypted, it has to be decrypted before querying the dump file.
I have no idea what encryption I can do in vb.net and mysql
Anyway, if I happen to know one, I dont know how can i use it.
Any help and input will be very helpful.
Thanks in advance.
I modified my first code
Process.Start("C:/MySQL/bin/mysqldump.exe", " --host=localhost --user='" & strUser & "' --password=1234 """ & strDbName & """ -r """ & strPath & newDBName & """, --cipher /e /a '" & newDBName & "' ")
but the output file contains nothing whatsover. TIA
Change your code to this,
Process.Start("C:/MySQL/bin/mysqldump.exe", " --host=localhost --user='" & strUser & "' --password=1234 """ & strDbName & """ -r """ & strPath & newDBName & """")
Process.WaitForExit()
Process.Start("C:\Windows\System32\cipher.exe", "/e /a '" & strPath & newDBName & "' ")