是咁的，小弟要幫公司寫一個program, 當一個folder裡面任意一個file被改動時，就自動send email attach埋個file俾大家。最簡單當然係用現有嘅野，所以選用了VBA + Window API timer. (其實我未寫過VBA...XD)
Put the following code in ThisOutlookSession:
Put the following code in ThisOutlookSession:
' Purpose: keep checking any modification of files inside a folder
' and send Email with the most updated file to the assigned recipients
Private Sub Application_Startup()
Call ActivateTimer(60) 'check every 1 minute
End Sub
Private Sub Application_Quit()
If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **記得記得記得**
End Sub
Put the following code in a new Module:
' Windows API timer functions
#If VBA7 And Win64 Then
' 64-bit (My system is 64-bit)
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, _
ByVal uElapse As LongLong, _
ByVal lpTimerFunc As LongLong) As LongLong
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal HWnd As LongLong, _
ByVal nIDEvent As LongLong) As LongLong
#Else
'32-bit
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
#End If
'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running
Public TimerID As LongLong
Public lmDate As Date 'Last modified date
Public Sub ActivateTimer(ByVal nMinutes As LongLong)
nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
lmDate = Now - 0.5 'First check: file modified within 12 hours
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
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 TriggerTimer(ByVal HWnd As LongLon
g, ByVal uMsg As LongLong, ByVal idevent As LongLong, ByVal Systime As LongLong)
g, ByVal uMsg As LongLong, ByVal idevent As LongLong, ByVal Systime As LongLong)
Dim objMail As Outlook.MailItem
Dim fso As Object 'Scripting.FileSystemObject
Dim strFile As String
Dim fsoFile 'As Scripting.File
Dim fsoFldr 'As Scripting.Folder
Dim dtNew As Date, sNew As String
Set fso = CreateObject("Scripting.FileSystemObject")
' Path to folder
strFile = "C:\User\Example\"
Set fsoFldr = fso.GetFolder(strFile)
For Each fsoFile In fsoFldr.Files
'Use .DateLastModified for modification or .DateCreated for creation
'Use .DateLastModified for modification or .DateCreated for creation
If fsoFile.DateLastModified > lmDate Then
sNew = fsoFile.Path
lmDate = fsoFile.DateLastModified
Set objMail = Application.CreateItem(olMailItem)
With objMail
.To = "colleagues@company.com"
.CC = "boss@company.com"
.Subject = "Updated File " & lmDate
.BodyFormat = olFormatHTML
.HTMLBody = "<html><body><p>Dear all,</p>" & _
"<p>Attached please find the updated file.</p>" & _
"<p style='color:gray;font-size:10pt;'><i>This email is generated automatically. " & _
"Please do not reply.</i></p>" & _
"<p>Attached please find the updated file.</p>" & _
"<p style='color:gray;font-size:10pt;'><i>This email is generated automatically. " & _
"Please do not reply.</i></p>" & _
"<p>Best regards,</p><p>Name</p></body></html>"
.Attachments.Add sNew
.Send
End With
End If
Next fsoFile
End Sub
沒有留言:
張貼留言