Bàn về giải pháp thực hiện trước nhé.
Theo cách tôi làm sẽ có 2 cách thực hiện:
1. Mở file excel hợp đồng trên cho chạy ngầm, kiểm tra rồi hiện thông báo nếu có, còn không thì lẳng lặng mà đóng.
2. Dùng VbScrip để kết nối, mở file excel, kiểm tra và hiện thông báo.
2 cách trên đều phải dùng công cụ có sẳn trong Windows là "Task Schedule" trong Control Panel để thiết lập nhiệm vụ tự động khởi chạy file Excel hoặc file VbScript trên ở một thời gian cố định trong ngày/ tuần mà bạn muốn kiểm tra. Ví dụ: khi mở máy tính lên, sẽ chạy tự động lúc 9:00 AM mỗi ngày để kiểm tra.
Các bạn khác có cách nào khác nữa thì chia sẽ cách làm để tham khảo nhé.
Bàn về giải pháp thực hiện trước nhé.
Theo cách tôi làm sẽ có 2 cách thực hiện:
1. Mở file excel hợp đồng trên cho chạy ngầm, kiểm tra rồi hiện thông báo nếu có, còn không thì lẳng lặng mà đóng.
2. Dùng VbScrip để kết nối, mở file excel, kiểm tra và hiện thông báo.
2 cách trên đều phải dùng công cụ có sẳn trong Windows là "Task Schedule" trong Control Panel để thiết lập nhiệm vụ tự động khởi chạy file Excel hoặc file VbScript trên ở một thời gian cố định trong ngày/ tuần mà bạn muốn kiểm tra. Ví dụ: khi mở máy tính lên, sẽ chạy tự động lúc 9:00 AM mỗi ngày để kiểm tra.
Các bạn khác có cách nào khác nữa thì chia sẽ cách làm để tham khảo nhé.
Mình gửi ý tưởng nếu bằng hoặc nhỏ hơn ngày hiện tại thì sẽ thông báo tới ngày thanh toán
còn việc để mở ra file theo link thì chắc nhờ anh chị khác hỗ trợ thêm nhe, mình thì chưa thể làm được.
Cũng được 90% không hiểu nếu báo thì đúng nhưng dùng lệnh mở file thì chỉ mở được 1 sheet, do vòng lặp tiếp theo nó chạy trên sheet hiện hành là file vừa mở.
Anh chị xem sai ở đâu nhe
Private Sub Workbook_Open()
Dim wb As Workbook
Dim Sh As Worksheet
Dim C As Range
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Set Sh = Sheets("aa")
For i = 2 To 10
For Each C In Worksheets("aa").Range("B" & i)
If Date >= C Then
Windows("test.xlsb").Activate
MsgBox "Hop dong " & Range("C" & i).Value & " da toi han thanh toan. Mo file click OK"
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Range("C" & i).Value
wb.Close SaveChanges:=False
End If
Next C
Next i
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Dim wb As Workbook
Dim Sh As Worksheet
Dim C As Range
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Set Sh = Sheets("aa")
For i = 2 To 10
For Each C In Worksheets("aa").Range("B" & i)
If Date >= C Then
Windows("test.xlsb").Activate
MsgBox "Hop dong " & Range("C" & i).Value & " da toi han thanh toan. Mo file click OK"
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Range("C" & i).Value
wb.Close SaveChanges:=Fals
End If
Next C
Next i
Application.ScreenUpdating = True
End Sub
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Bạn tạo 2 cái task cho 2 khung giờ nhé. Chọn Daily, Start a program là đường dẫn trực tới file excel có macro tự chạy của bạn, không cần thông qua file vbs để chạy file excel.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Bạn giải nén file đính kèm.
- Vào 2 file (.vbs), mở bằng NotePad để sửa đường dẫn như đã ghi chú.
- Chạy file TaoTaskSchedule.vbs với quyền Admin (Run as Administrator) -> Xong.
- Muốn gỡ bỏ cái Task vừa tạo thì chạy file BoTaskSchedule.vbs
Cách thức nó hoạt động:
- File check.vbs sẽ mở file Excel có danh sách cần thông báo (với cột hiển thị tình trạng thông báo), kiểm tra và hiện thông báo nếu có. Qui ước là dùng từ "notice" để thông báo tình trạng cần thông báo (dùng công thức). Muốn dùng từ khác thì phải sửa code trong file này.
- File TaoTaskSchedule.vbs dùng để đăng ký (tạo) Task vào chương trình Task Scheduler mặc định của Windows (khỏi phải tạo thủ công). Theo file đính kèm thì tôi tạo Task là mỗi ngày vào lúc 9:00 AM sẽ tự động kiếm file check.vbs và chạy.
- Code file check.vbs:
JavaScript:
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Temp\Tu dong kiem tra thong bao\ThongBaoNhac.xlsx") '<-- Tự đổi đường dẫn theo máy
iRow = 2
Do While objExcel.Cells(iRow, 4).Value <> "" 'Cột [Ngày xác nhận]. Duyệt đến dòng cuối.
If objExcel.Cells(iRow, 5).Value = "Notice" Then 'Cột [Thông báo]
msg = "C" & ChrW(243) & " kh" & ChrW(225) & "ch h" & ChrW(224) & "ng c" & ChrW(7847) & "n g" & ChrW(7917) & "i th" & ChrW(244) & "ng b" & ChrW(225) & "o nh" & ChrW(7855) & "c nh" & ChrW(7903) & vbCrlf _
& "B" & ChrW(7845) & "m [Yes] " & ChrW(273) & ChrW(7875) & " m" & ChrW(7903) & " file Excel, [No] " & ChrW(273) & ChrW(7875) & " " & ChrW(273) & ChrW(243) & "ng."
intRet= WshShell.Popup (msg,0,"L" & ChrW(432) & "u " & ChrW(253),64+4)
if intRet=vbYes Then
objExcel.visible = true
Set WshShell = Nothing
WScript.Quit
Else
exit do
end if
End If
iRow = iRow + 1
Loop
objWorkbook.Close acSave
Set objWorkbook = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
if objExcel.Workbooks.Count = 0 Then
objExcel.Quit
End If
Set objExcel = Nothing
Set WshShell = Nothing
WScript.Quit
Code file TaoTaskSchedule.vbs:
JavaScript:
' A constant that specifies a daily trigger.
const TriggerTypeDaily = 2
' A constant that specifies an executable action.
const ActionTypeExec = 0
'********************************************************
' Create the TaskService object.
Set service = CreateObject("Schedule.Service")
call service.Connect()
'********************************************************
' Get a folder to create a task definition in.
Dim rootFolder
Set rootFolder = service.GetFolder("\")
' The taskDefinition variable is the TaskDefinition object.
Dim taskDefinition
' The flags parameter is 0 because it is not supported.
Set taskDefinition = service.NewTask(0)
'********************************************************
' Define information about the task.
' Set the registration info for the task by
' creating the RegistrationInfo object.
Dim regInfo
Set regInfo = taskDefinition.RegistrationInfo
regInfo.Description = "Chạy file Check.vbs mỗi ngày"
regInfo.Author = "Administrator"
'********************************************************
' Set the principal for the task
Dim principal
Set principal = taskDefinition.Principal
' Set the logon type to interactive logon
principal.LogonType = 3
' Set the task setting info for the Task Scheduler by
' creating a TaskSettings object.
Dim settings
Set settings = taskDefinition.Settings
settings.Enabled = True
settings.StartWhenAvailable = True
settings.Hidden = False
'********************************************************
' Create a time-based trigger.
Dim triggers
Set triggers = taskDefinition.Triggers
Dim trigger
Set trigger = triggers.Create(TriggerTypeDaily)
' Trigger variables that define when the trigger is active.
Dim startTime, endTime
Dim time
startTime = "2025-01-07T09:00:00" 'Bắt đầu chạy lúc 9:00 AM mỗi ngày
endTime = "2027-01-07T09:00:00"
WScript.Echo "startTime :" & startTime
WScript.Echo "endTime :" & endTime
trigger.StartBoundary = startTime
trigger.EndBoundary = endTime
trigger.DaysInterval = 1 'Task runs every day.
trigger.Id = "DailyTriggerId"
trigger.Enabled = True
' Set the task repetition pattern for the task.
' This will repeat the task 5 times.
Dim repetitionPattern
Set repetitionPattern = trigger.Repetition
repetitionPattern.Duration = "PT4M"
repetitionPattern.Interval = "PT1M"
'***********************************************************
' Create the action for the task to execute.
' Add an action to the task to run notepad.exe.
Dim Action
Set Action = taskDefinition.Actions.Create( ActionTypeExec )
Action.Path = "C:\Mac\Home\Downloads\TuDongChayExcel\check.vbs"
WScript.Echo "Đã tạo Task Schedule thành công."
'***********************************************************
' Register (create) the task.
call rootFolder.RegisterTaskDefinition( _
"Kiem tra ngay den han", taskDefinition, 6, , , 3)
WScript.Echo "Task submitted."
WScript.Quit
* Lưu ý: đối với file .vbs thì Windows chỉ hỗ trợ đến năm 2027 (theo thông báo). Sau đó thì phải chuyển qua Power Shell, cái này tôi chưa làm.
pen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
