I'm trying to run Outlook code 10 seconds after an email is received.
I tried using application.wait but it appears that you cannot do this with Outlook.
How do I pause Outlook for a given amount of time?
You can create a Sub that will mimic the Application.Wait, something like.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'For 64-Bit
'Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub Pause(intSeconds As Variant)
' Comments: Waits for a specified number of seconds
' Params : intSeconds Number of seconds to wait
' Source : Total Visual SourceBook
On Error GoTo PROC_ERR
Dim datTime As Date
datTime = DateAdd("s", intSeconds, Now)
Do
' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
Sleep 100
DoEvents
Loop Until Now >= datTime
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , "Pause Method"
Resume PROC_EXIT
End Sub
To call this you could use Pause 3
Here's a simple way:
T0 = Now + TimeValue("0:00:10")
Do Until Now > T0
Loop
Throw a DoEvents in this and it'll be okay
T0 = Now + TimeValue("00:00:10")
Do Until Now > 10
DoEvents
Loop
I'm not sure the need for complicated function..
Try This:
#If VBA7 Then
'Code is running VBA7 (2010 or later).
#If Win64 Then
'Code is running in 64-bit version of Microsoft Office.
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
'Code is running in 32-bit version of Microsoft Office.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
#Else
'Code is running VBA6 (2007 or earlier).
#End If
Sub Test()
Debug.Print Now
Sleep 10000
Debug.Print Now
End Sub
Related
I have the below code for Outlook 365 which will run a macro after sending an email.
How do I modify this to delay the macro 10 seconds after clicking send, and how do I limit this code to my exchange account email which is the default email account?
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
With Item
Call BatchResendEmailsMacro
End With
End Sub
Outlook doesn't have a timer function but you can use Appointment or Task Reminders to trigger macros. Set up an Application_Reminder macro that will do something when a reminder fires. To limit it to running when specific reminders fire, use an If statement to look for words in the subject or a specific category.
If you want the macro to fire a specified time after you restart Outlook, use an Application_Startup macro to create the appointment. Read more about that in the Running Outlook Macros on a Schedule article.
Also you may consider using Windows API functions such as SetTimer and KillTimer. Outlook VBA - Run a code every half an hour page provides a sample code (for example, that is for Windows x64):
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong
Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running
Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
MsgBox "The TriggerTimer function has been automatically called!"
End Sub
Public Sub DeactivateTimer()
Dim lSuccess As LongLong
lSuccess = KillTimer(0, TimerID)
If lSuccess = 0 Then
MsgBox "The timer failed to deactivate."
Else
TimerID = 0
End If
End Sub
Public Sub ActivateTimer(ByVal nMinutes As Long)
nMinutes = nMinutes * 1000 * 60
'The SetTimer call accepts milliseconds, so convert to minutes
If TimerID <> 0 Then Call DeactivateTimer
'Check to see if timer is running before call to SetTimer
TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
If TimerID = 0 Then
MsgBox "The timer failed to activate."
End If
End Sub
You could trigger the code with the ItemAdd event on the Sent Items folder.
Option Explicit
' In the ThisOutlookSession module
Private WithEvents sentItems As Items
Private Sub Application_Startup()
Dim sentItemsFolder As Folder
' default Sent Items folder
Set sentItemsFolder = Session.GetDefaultFolder(olFolderSentMail)
Set sentItems = sentItemsFolder.Items
End Sub
Private Sub sentItems_ItemAdd(ByVal item As Object)
Dim waitTime As Long
Dim waitDiff As Long
Dim delay As Date
Dim waitStart As Date
waitTime = 10 ' in seconds
Debug.Print vbCr & "Wait start: " & Now
waitStart = Now
delay = DateAdd("s", waitTime, waitStart)
Debug.Print "Wait until: " & delay
Do Until Now >= delay
DoEvents
Loop
Debug.Print "Wait end..: " & Now
waitDiff = DateDiff("s", waitStart, Now)
Debug.Print waitDiff & " seconds delay."
Debug.Print "Call BatchResendEmailsMacro"
'Call BatchResendEmailsMacro
Debug.Print "Done."
End Sub
Private Sub test()
sentItems_ItemAdd ActiveInspector.currentItem
End Sub
I am trying to make a countdown in VBA, that displays the seconds in a textbox1. I am using this code below, but nothing happens and the textbox doesn't increment each second. I have tried doing Endtick / 1000 too because it's ms, but to still now avail. Is this the right method I should be using?
Other stuff is happening in the app as the timer is running, so I can't use the WAIT function.
Private Sub CommandButton2_Click()
timer (10)
End Sub
Sub timer(Finish As Long)
Dim NowTick As Long
Dim EndTick As Long
EndTick = GetTickCount + (Finish * 1000)
Do
NowTick = GetTickCount
DoEvents
UserForm1.TextBox1.Text = GetTickCount
Loop Until NowTick >= EndTick
msgbox("Time is up")
End Sub
Add this to a module, separate from the userform code:
Option Explicit
#If Win64 Then
Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If
Sub timer(Finish As Long)
Dim EndTick As Long
EndTick = GetTickCount + (Finish * 1000)
Do
DoEvents
UserForm1.TextBox1.Text = (EndTick - GetTickCount) / 1000
Loop Until GetTickCount >= EndTick
UserForm1.TextBox1.Text = 0
MsgBox ("Time is up")
End Sub
Is there any way to check until file exists in VBA.
what I am trying to do is, making vba call asynch.
Now after I run
wshShell.Run """" & SFilename & """" & s
I want to check until file exists like this
Wait until fso.fileexists("file")
Msgbox "file is now available"
End wait!!!
is there any way in vba?
I am using word vba.
You can do it like this:
Do
If fso.FileExists("file") Then
Exit Do
End If
DoEvents 'Prevents Excel from being unresponsive
Application.Wait Now + TimeValue("0:00:01") 'wait for one second
Loop
MsgBox "file available", vbOKOnly, ""
Although this is surely not the best method
Instead of using Application.Wait, you can use sleep:
Sleep 1000 '1 Second
but you need to add this to your code to be able to use it:
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems
#End If
You need a timeout to avoid an endless loop. This function returns true if it found the file and false if timeout was reached.
Option Explicit
Const timeoutSeconds As Long = 128
Private localFSO As Object
Public Function FSO() As Object
If localFSO Is Nothing Then Set localFSO = CreateObject("Scripting.FileSystemObject")
Set FSO = localFSO
End Function
Public Function WaitForFileToExist(ByVal theFileName As String) As Boolean
Dim timeElapsed As Single
Dim startTime As Single
startTime = Timer
Do
If FSO.FileExists(theFileName) Then
WaitForFileToExist = True
Exit Do
End If
DoEvents
Application.Wait Now + TimeValue("0:00:01")
timeElapsed = Timer - startTime
Loop Until timeElapsed > timeoutSeconds
End Function
I am building a Windows Forms Application on VS2010, through which I need to execute a 3d party DOS shell program (OpenSees.exe), open a source file in it and perform an analysis. After this, some output files are created which I need to read again in my VB.NET app.
The thing is that the analysis in OpenSees may take a long time, so the VB code has to wait for it before carrying on.
For this, I have tried both "ShellandWait" sub along with "WaitForSingleObject" function and "process class" option, but neither of then works.
My DOS shell program initializes, but it closes almost immediately, not letting the analysis to complete and the required output to be created.
Here are the code snippets I used:
1st try: ShellandWait
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub ShellAndWait(ByVal program_name As String, _
Optional ByVal window_style As AppWinStyle = vbNormalFocus, _
Optional ByVal max_wait_seconds As Long = 0)
Dim lngProcessId As Long
Dim lngProcessHandle As Long
Dim datStartTime As Date
Const WAIT_TIMEOUT = &H102
Const SYNCHRONIZE As Long = &H100000
Const INFINITE As Long = &HFFFFFFFF
' Start the program.
On Error GoTo ShellError
lngProcessId = Shell(program_name, window_style)
On Error GoTo 0
Threading.Thread.Sleep(1500)
'System.Windows.Forms.Application.DoEvents()
SendKeys.Send("source " & filename & ".tcl")
SendKeys.Send("{ENTER}")
' Wait for the program to finish.
' Get the process handle.
lngProcessHandle = OpenProcess(SYNCHRONIZE, 0, lngProcessId)
If lngProcessHandle <> 0 Then
datStartTime = Now
Do
If WaitForSingleObject(lngProcessHandle, 250) <> WAIT_TIMEOUT Then
Exit Do
End If
'DoEvents()
If max_wait_seconds > 0 Then
If DateDiff("s", datStartTime, Now) > max_wait_seconds Then Exit Do
End If
Loop
CloseHandle(lngProcessHandle)
End If
Exit Sub
ShellError:
End Sub
...
ShellAndWait("OpenSees.exe", , 3)
2nd try: ProcessStart
Dim p As New Process
Dim psi As New ProcessStartInfo("OpenSees.exe", "source " & filename & ".tcl")
p.StartInfo = psi
p.Start()
p.WaitForExit()
I don't understand why this isn't working. Any help would be much appreciated!
Try this:
Shell("OpenSees.exe <arguments>",, True)
How do you determine if the computer you are on is a 32-bit machine or a 64-bit machine?
I need this done in vba preferrably.
#Wouter Simon's answer is sort of on the right track, but really incomplete. It is missing a couple of Declare statements as well as some kind of explanation.
Therefore I believe it's worth presenting a more complete and working version here.
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long '()
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function IsWow64Process Lib "kernel32" _
(ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
Sub CheckWhetherIts64()
Dim Its64 As Long
Dim handle As Long
handle = GetProcAddress(GetModuleHandle("kernel32"), _
"IsWow64Process")
If handle > 0 Then ' IsWow64Process function exists
' Now use the function to determine if
' we are running under Wow64
IsWow64Process GetCurrentProcess(), Its64
End If
If Its64 = 1 Then
MsgBox "it's a 64 bit process."
End If
End Sub
Caveat:
For compatibility with operating systems that do not support this function, call GetProcAddress to detect whether IsWow64Process is implemented in Kernel32.dll. If GetProcAddress succeeds, it is safe to call this function. Otherwise, WOW64 is not present. Note that this technique is not a reliable way to detect whether the operating system is a 64-bit version of Windows because the Kernel32.dll in current versions of 32-bit Windows also contains this function.
http://msdn.microsoft.com/en-us/library/ms684139%28v=vs.85%29.aspx
got it from
http://www.msoffice.us/Access/PDF/Extending%20VBA%20with%20APIs.pdf. Seems like it is working on mine.
Option Compare Database
Type SYSTEM_INFO
wProcessorArchitecture As Integer
wReserved As Integer
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
Declare Sub GetNativeSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Function Is64BitProcessor() As Boolean
Const PROCESSOR_ARCHITECTURE_AMD64 As Integer = 9
Const PROCESSOR_ARCHITECTURE_IA64 As Integer = 6
Dim si As SYSTEM_INFO
' call the API
GetNativeSystemInfo si
' check the struct
Is64BitProcessor = (si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 _
Or _
si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64)
End Function
http://msdn.microsoft.com/en-us/library/ms724340(v=vs.85).aspx
To determine whether the running Office is 64-bit or 32-bit:
Use IsWow64Process (answer from Jean-François Corbett).
To determine whether Windows is 64-bit or 32-bit:
Public Function isWin64bit() As Boolean
isWin64bit = 0 < Len(Environ("ProgramW6432"))
End Function
I think the most straightforward way is:
#If Win64 Then
MsgBox "Win 64"
#Else
MsgBox "Win 32"
#End If
Sometimes it is also useful to check whether your Office is 32 or 64 and use this information to access the correct key in registry. So you can do:
#If Win64 Then
#If VBA7 Then
MsgBox "Win 64 and Office 64" ' HKEY_LOCAL_MACHINE\SOFTWARE\YourApp
#Else
MsgBox "Win 64 and Office 32" ' HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\YourApp
#End If
#Else
MsgBox "Win 32 and Office 32" ' HKEY_LOCAL_MACHINE\SOFTWARE\YourApp
#End If
HTH
Conditional compilation could be very useful, WinXX detects environment but not hardware properties, example below :
Dim mVers As String
Sub Init()
#If Win64 Then
mVers = "Win64" ' Win64=true, Win32=true, Win16= false
Call VerCheck
#ElseIf win32 Then
mVers = "Win32" ' Win32=true, Win16=false
Call VerCheck
#ElseIf win16 Then
mVers = "Win16" ' Win16=true
Call VerCheck
#End If
End Sub
Sub VerCheck()
MsgBox "Version: " & mVers, vbInformation, "Version"
End Sub
I think VBA may be linked to the office version that is running and it really matters what type of process is running. This code snippet may help (VB6 code)
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" _
handle = GetProcAddress(GetModuleHandle("kernel32"), _
"IsWow64Process")
If handle > 0 Then ' IsWow64Process function exists
' Now use the function to determine if
' we are running under Wow64
IsWow64Process GetCurrentProcess(), bolFunc
End If