I found a code online:
Public Sub showProcesses()
Dim W As Object
Dim ProcessQuery As String
Dim processes As Object
Dim process As Object
Set W = GetObject("winmgmts:")
ProcessQuery = "SELECT * FROM win32_process"
Set processes = W.execquery(ProcessQuery)
For Each process In processes
MsgBox process.Name
MsgBox process.Description
Next
Set W = Nothing
Set processes = Nothing
Set process = Nothing
End Sub
It prints out the name and description of all active processes.
Example:
TeraPad.exe acad.exe WINWORD.EXE EXCEL.EXE ...
With the code below I got the window names of the applications that are available in the Taskbar:
Private Sub AppActivates(WindowName As String)
Dim WD, task, n As Long
Set WD = CreateObject("Word.Application")
For Each task In WD.Tasks
MsgBox task.Name
Next
WD.Quit
Set WD = Nothing
End Sub
Example:
Basic_vba.pdf - Adobe Acrobat Reader DC AutoCAD Mechanical 2016 - [sample_model.dwg] 20170424.txt - TeraPad ...
The application acad.exe [AutoCAD] is in the taskbar(status is Minimum), I want to open(call) it's windows up in VBA.
Is that possible?
Any tips on these will be great help.
You can use the AppActivate method along with the window title (which just happens to be the name of the task).
VBA.AppActivate("Basic_vba.pdf - Adobe Acrobat Reader DC")
If the window is minimized, then you'll need to send a message to the window to restore or maximize it.
Related
I'm trying to target an existing IE window (one tab only) with my script.
In other words: there's an Internet Explorer window opened with a specific tab and I'm trying to get my script to target that tab using its tab name.
I had a look at these topics, but none worked for me (or I did it wrong):
Get existing IE via VBA
Navigate to new URL in existing Internet Explorer window
VBA Macro For Already Open IE Window
Therefore I created this (which worked for a while until I got a 438 Error for no reason) :
Sub FindingExistingIE()
Dim Application As Object
Dim ApplicationWindows As Object
Dim WindowTitle As Variant
Dim TargetWindow As Object
Set Application = CreateObject("Shell.Application")
Set ApplicationWindows = Application.Windows
For Each Application In ApplicationWindows
WindowTitle = Application.Document.Title
If WindowTitle Like "IE Window Title" Then
Set TargetWindow = Application
Exit For
End If
Next Application
NextSub TargetWindow
End
End Sub
As I said, the script worked fine for a week but now I get the 438 error:
Object doesn't support this property or method (Error 438)
The error highlights the following line:
WindowTitle = Application.Document.Title
Having read the Microsoft Doc related to the error, I tried changing the WindowTitle variable to an object. Didn't work.
Does anyone have an idea?
Thanks!
This works for me - finds IE by looking for an open window with the passed URL:
Sub tester()
Dim w As Object
Set w = FindingExistingIEByUrl("https://www.google.com")
If Not w Is Nothing Then
MsgBox w.document.Title
Else
MsgBox "No IE window found"
End If
End Sub
Function FindingExistingIEByUrl(theUrl)
Dim w As Object
For Each w In CreateObject("Shell.Application").Windows
'Debug.Print w.locationurl
If w.locationurl Like theUrl & "*" Then
Set FindingExistingIEByUrl= w
Exit Function
End If
Next w
End Function
Function FindingExistingIEByTitle(theTitle)
Dim w As Object, t As String
For Each w In CreateObject("Shell.Application").Windows
t = ""
On Error Resume Next 'ignore error if no Document
t = w.Document.Title
On Error Goto 0
If t Like theTitle Then
Set FindingExistingIEByTitle = w
Exit Function
End If
Next w
End Function
When you preview a report, right-click offers the option, Send to... -> Mail Recipient.
I need to catch this event and execute code the reads the recipient e-mail address as typed into Outlook when it appears. This code should be in a module in the Access database.
If possible, I would also like to read the Subject.
It's hard to find answers on the Web, and despite some experience with Access and VBA, I don't know how to even start.
Edit: From Dmitry's answer I found this loop through Inspectors,
Private Sub Form_Timer()
Dim myInspectors As Outlook.Inspectors
Dim x As Integer
Dim iCount As Integer
Set myInspectors = Application.Inspectors
iCount = Application.Inspectors.Count
If iCount > 0 Then
For x = 1 To iCount
MsgBox myInspectors.Item(x).Caption
Next x
Else
MsgBox "No inspector windows are open."
End If
End Sub
but it gives this compile error:
Edit 2:
I have moved the code into a function, and when Outlook is running, I get no errors from this GetObject call. But with this function on a 2s timer, objApp.Inspectors.Count remains 0 while I compose an email and send it.
Public Function checkInspectors() As Boolean
Dim myInspectors As Outlook.Inspectors
Dim OutLookWasNotRunning As Boolean
Dim objApp As Object
Set objApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then OutLookWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
If Not OutLookWasNotRunning Then
Set myInspectors = objApp.Inspectors
Dim x As Integer
Dim iCount As Integer
iCount = objApp.Inspectors.Count
If iCount > 0 Then
For x = 1 To iCount
Debug.Print myInspectors.Item(x).Caption
Next x
Debug.Print "---"
Else
'MsgBox "No inspector windows are open."
End If
End If
End Function
Normally, Application.Inspectors.NewInspector event would fire, but Outlook disables that event for the messages opened through Simple MAPI. Your best bet is to scan the Application.Inspectors collection periodically (timer?) to check if there is a new inspector open.
Once you have an Inspector object, you can check the Inspector.CurrentItem.Recipients collection.
Well, one of the possible solutions is to develop an Outlook add-in or VBA macro which may track outgoing emails. The ItemSend event of the Application class which is fired whenever a Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program.
I am trying to make an application in which I open several type of Files using vb.net and then I want to be able to minimize and maximize a specific opened file using its name.
The problem is that some files open as windows for the same process name for example (Excel, notepad, word, autocad).
I tried to use the process ID to control the windows but the process ID remain the same for all the files that belong to the same process.
This is the function that I use to minimize the window but it only control the Main Window of the process not a specific one
Public Sub Minimize(Id As Integer)
Dim localById As Process = Process.GetProcessById(Id)
Try
ShowWindow(localById.MainWindowHandle, 2) '
Catch ex As Exception
End Try
End Sub
But I really don't know how to proceed. My target is to be able to minimize or maximize a specific opened window of a process using its name.
for example if I open a word file by the name "Config.docx" and another file by the name "Specifications.docx" the two files appear in the taskmanager as "Microsoft Word (2)" and what i am trying to do is to control not only the main window of a process but each window using its name.
Can anyone Help me?
Set the workbook as active using the index - the workbook you want to manipulate (Minimize, Maximize)
Private Sub btnOpenFile_Click(sender As Object, e As EventArgs) Handles btnOpenFile.Click
Dim myExcel As Excel.Application
Dim aWorkbook As Excel.Workbook
Dim abook1 As Excel.Workbook
Dim abook2 As Excel.Workbook
Dim abook3 As Excel.Workbook
myExcel = New Excel.Application
'index = 1
aWorkbook = myExcel.Workbooks.Open("D:\Dev\Debug\Reports\2017-11-07T08_54_42_Report.xls")
'index = 2
abook1 = myExcel.Workbooks.Open("D:\Dev\Debug\Reports\2017-11-07T12_38_40_Report.xls")
'index = 3
abook2 = myExcel.Workbooks.Open("D:\Dev\Debug\Reports\2017-11-09T09_23_40_Report.xls")
'index = 4
abook3 = myExcel.Workbooks.Open("D:\Dev\Debug\Reports\2017-11-09T09_35_00_Report.xls")
myExcel.Visible = True
myExcel.WindowState = Excel.XlWindowState.xlMinimized
myExcel.Workbooks(3).Activate()
Dim T As Excel.Application
T = myExcel.ActiveWorkbook.Parent
T.WindowState = Excel.XlWindowState.xlMaximized
'Don't forget to cleanup excel stuff aka close it and release stuff :)
End Sub
I have created several MS Access databases that connect to my company's SQL server (MSSQL), perform calculations, then export the results in the form of email. These are set up to run through the windows task scheduler at a certain time of the day. Before you ask, I do not have access to the SQL server so I cannot create any stored procedures or do anything other than read. These run on a desktop computer under my desk which is on 100% of the time (other than a weekly reboot).
The issue I am having is with using VBA in MS Access to actually send the emails. All of the SQL and excel formatting work as intended, but I ran into the issue of Access closing Outlook before the email leaves my outbox. Attempts to make Access wait or sleep until emails have been sent are causing the program to indefinetly hang. I would greatly appreciate any help you can provide on how to resolve this issue.
Thank you and please see below. My best guess at this point is that the sleep or wait methods I have used get stuck when two seperate Access Databases attempt to use them at the same time. I suspect this because when I run each process independently to debug, they are able to run without issues.
Windows Task Scheduler:
6:30AM (Task 1)(Run Time 2mins)- Access opens an internet page, pulls data, formats in excel, and saves to a network drive where a different program (not written by me) scoops up the data at 7:00 and uploads to SQL server. This is the first scheduled task and rarely has issues.
7:30AM (Task 2)(Run Time 5 mins) - Access connects to SQL, runs queries, exports results to excel file (no email).
7:35AM (Task 3)(Run Time 1.5hours) - Access connects to SQL, runs lots of very big queries, then exports file to excel and attempts to send emails. This one has issues where file is created and when I attempt to email, it either sits in outbox until I open outlook or file is created and it has trouble sending the email.
8:00AM (Task 4)(Run Time 3 mins) - Access connects to SQL, runs queries, sends emails. Usually has no issues but occasionally emails get stuck in Outbox.
8:00AM (Task 5)(Run Time 30 mins) - Access connects to SQL, runs queries, gets files from task 2, sends emails.
For all tasks, these are the settings:
Run only when user is signed on.
Run with highest privileges.
Action - Start a program (.bat)
The .bat files have this general format:
#echo on
cscript SCRIPT_NAME.vbs
The .vbs files have this general format:
Dim oAccessApp
Set oAccessApp = createObject("Access.Application")
oAccessApp.OpenCurrentDataBase("C:\PATHNAME.accdb")
oAccessApp.Visible = True
oAccessApp.Run "VBA_FUNCTION_NAME", "PARAMETERS"
oAccessApp.Application.Quit
Set oAccessApp = nothing
Outlook VBA Module
I suspect the issue I am having is related to the way I am sending the emails because the files output correctly even if the emails are not sent. Also, the code is able to run correctly when I test each .bat independently. Below please find my code that I use to send the emails.
Option Compare Database
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function sendToOutlook(sWhNo As String)
Dim s As String
Dim n As Integer
n = FreeFile()
Open "C:\PATHNAME\logfile.txt" For Output As #n
s = "Hello, world!"
Print #n, s
Dim XL As Excel.Application
Dim XlBook As Excel.Workbook
Dim fileNameLocation As String
Dim olApp As Outlook.Application
Dim olInsp As Outlook.Inspector
Dim olMail As Outlook.MailItem
Dim olAttachments As Outlook.Attachments
Dim subjectStr As String
Dim sWhString As String
Select Case sWhNo
Case "CASE_STATEMENTS_HERE"
subjectStr = "CITY_NAME"
sWhString = subjectStr
'more cases
End Select
Print #n, subjectStr
Print #n, sWhString
toStr = "email1#example.com;email2#example.com, etc"
bccStr = ""
subjectStr = subjectStr & "_" & exportTime & " REPORT_NAME"
fileLocation = "C:\TASK2_FILEPATH"
XlFileFormatStr = ".xlsx"
Print #n, toStr
Print #n, ccStr
Print #n, subjectStr
Print #n, fileLocation
Print #n, XlFileFormatStr
Dim qryRange1 As Excel.Range
Dim sFileLocation As String
Dim sFileName As String
Dim sFullFileNameLoc As String
Dim sMonthNum As String
Dim sDayNum As String
sFileLocation = "C:\CURRENT_TASK_PATHNAME\"
sDayNum = Day(Date)
If sDayNum - 10 < 0 Then sDayNum = "0" & Day(Date)
sMonthNum = Month(Date)
If sMonthNum - 10 < 0 Then sMonthNum = "0" & Month(Date)
sFileName = sWhNo & "_REPORT_NAME_" & Year(Date) & sMonthNum & sDayNum & ".xlsx"
Print #n, sFileName
sFullFileNameLoc = sFileLocation & sFileName
Print #n, sFullFineNAmeLoc
Set XL = CreateObject("Excel.Application")
Set XlBook = XL.Workbooks.Open(sFullFileNameLoc)
XL.DisplayAlerts = False
XL.AskToUpdateLinks = False
XL.EnableEvents = False
XL.Visible = True
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
On Error Resume Next
Set olApp = New Outlook.Application
If Err.Number = 429 Then
Print #n, "429!!!"
Debug.Print "429!!!"
Set olApp = GetObject(, "Outlook.Application")
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
GoTo LBL_CLOSE
End If
Set olInsp = olApp.ActiveInspector
Set olMail = olApp.CreateItem(olMailItem)
Set olAttachments = olMail.Attachments
olMail.SentOnBehalfOfName = "group_mailbox#example.com"
Print #n, "NO 429"
olAttachments.Add ("C:\TASK2_FILEPATH\" & exportFileNameGlobal_FINAL)
LBL_CLOSE:
Set qryRange1 = XlBook.Sheets("SHEET_NAME").Range(XlBook.Sheets("SHEET_NAME").Cells(1, 1).Address(), XlBook.Sheets("SHEET_NAME").Cells(11, 14).Address())
With olMail
.To = toStr
.CC = ccStr
.BCC = bccStr
.Subject = subjectStr
.HTMLBody = "Please find attached blah blah blah " & sWhString & vbCrLf & RangetoHTML(qryRange1, XL)
.Display
End With
Dim olAppNS As Outlook.Namespace
Dim olFolder As Outlook.Folder
With olMail
.Send
End With
XlBook.Close
XL.Quit
Set XlBook = Nothing
Set XL = Nothing
olApp.Quit
Set olApp = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olAttachments = Nothing
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
Dim mySyncObject As Outlook.SyncObject
Dim sync As Outlook.SyncObject
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
For i = 1 To mySyncObjects.Count
Set sync = mySyncObjects(i)
sync.Start
Next
Do While olFolder1.Items.Count > 0
Sleep 10000
Loop
Close #n
Sleep 60000
olApp1.Quit
Set olApp1 = Nothing
Please advise what I am doing wrong that is causing access to hang and how I should fix. I greatly appreciate any help that you can provide. Thank you.
If you are using Exchange, you can turn cached mode off - message will be sent immediately. Otherwise you have no choice but to start the sync (SyncObject.Start) and wait for the SyncObject.SyncEnd event to fire.
Because of the nature of Office Applications, I'd guess that you're sleeping its only thread and it literally cannot attempt to send the mail while you're either eating up or throwing away all its CPU time. Instead of polling the mailbox and trying to manually wait for the mailitems to send, try using that SyncObject you've already made to register an event handler.
Here's an idea of what I mean. The following is a new class module:
Dim WithEvents mySync As Outlook.SyncObject
Dim myApp As Outlook.Application
Sub Close_After(ByRef toClose As Outlook.Application, ByRef newSync As Outlook.SyncObject)
Set myApp = toClose
Set mySync = newSync
mySync.Start
End Sub
Private Sub mySync_SyncEnd()
myApp.Quit
End Sub
This wraps around a SyncObject and gives it an event handler that will close the current application.
And in your calling code, do something like:
Dim syncClose As New SyncHandler ' Scope to module so we don't lose the reference
Function sendToOutlook(sWhNo As String)
' ...
Dim olApp1 As Outlook.Application
Set olApp1 = New Outlook.Application
' ...
Set olAppNS = olApp1.GetNamespace("MAPI")
Set olFolder1 = olAppNS.GetDefaultFolder(olFolderOutbox)
Set mySyncObjects = olAppNS.SyncObjects
syncClose.Close_After olApp1, (mySyncObjects(1))
End Function
This passes the first SyncObject into your class, which starts the sync and, when the sync completes, closes the passed-in Outlook.Application. If (for some reason) you have more than one SyncObject you want to wait for you'll have to restructure to ensure all have already finished before closing the app. The concept will be the same, though - build wrappers that register event handlers (or one big wrapper class that handles the events of many individual SyncObjects), but add a check that all the syncs must complete before the Application closes.
Although you indicate you want to use outlook, I found it was easier to not rely on Outlook for sending email, so I've used CDO for a very similar application. See email using Access and VBA without MAPI
Please advise me on parts of this or the whole thing if possible. I basically have an email every morning with 5-8 links to reports (on Sharepoint) and have to click each one, which then opens an excel document with the report, click refresh all, save then go back to outlook and click the next link. Is there a way to open the first link in Outlook, go to excel refresh all, save, then go back to Outlook and open the next link and repeat until all links have been pressed in VBA? Any and all help is greatly appreciated, Thank you.
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Sub Hyperlink(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)
For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
splitWord.Hyperlink.Select
Next
Next
Set itm = Nothing
End Sub
Sub test()
Dim currItem As MailItem
Set currItem = GetCurrentItem
Hyperlink currItem
End Sub
This is what I have come up with so far. Definitely contains errors. I just run the sub test() in the end.
There is a .Follow in Word.
Sub Hyperlink(itm As mailitem)
Dim oDoc As Object
Dim h As Hyperlink
If itm.GetInspector.EditorType = olEditorWord Then
Set oDoc = itm.GetInspector.WordEditor
For Each h In oDoc.Hyperlinks
Debug.Print h.Name
If Right(h.Name, 5) = ".xlsx" Then
h.Follow
End If
Next
End If
Set oDoc = Nothing
End Sub
You can handle the NewMailEx event of the Application class to handle all incoming emails. Then in the event handler you can parse the HTMLBody property value and extract links. Then you can do whatever you need with links - open them in the browser and etc.
I'd recommend starting from the Getting Started with VBA in Outlook 2010 article in MSDN. Then you may find a lot of HOWTO articles in the Concepts (Outlook 2013 developer reference) section.
Your problem is a bit too large, and although not too difficult, it involves multiple object library references (Regular Expressions, Internet Explorer, Excel). It is unlikely you that you will get a full solution to your problem. VBA is a really powerful and cool scripting language and not too difficult to learn. I highly recommend you divide your problem into smaller tasks, and try to work each task separately and come back with more specific questions.