Em thấy PhanTuHuong có bái viết này anh xem thế nào có thể áp dụng được không
Option Compare Text
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lhKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal lhKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lhKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Const REG_HEX As Long = 4 'Hex Key
Private Const HKEY_CURRENT_USER As Long = &H80000001
Public Enum eApplication
eExcel
eOutlook
eWord
ePowerPoint
ePublisher
End Enum
Public Enum eVersion
eOffice2003
eOffice2000
eOfficeXP
End Enum
'Purpose : Enables or disables the macro virus alert.
'Inputs : bDisableVirusChecking True, disables macro security protection
' False, enables macro security protection
'Outputs : Returns True on success
'Author : Andrew Baker (
www.vbusers.com)
'Date : 25/11/2000 03:33
'Notes : Requires Excel 97
'Revisions :
Function Excel97MacroSecurity(bDisableVirusChecking As Boolean) As Boolean
Dim lData As Long, lRet As Long
Const csPath = "Software\Microsoft\Office\8.0\Excel\Microsoft Excel", csValue = "Options6"
On Error GoTo ErrFailed
If bDisableVirusChecking Then
lData = 0 'Disabled
Else
lData = 8 'Enabled
End If
RegCreateKey HKEY_CURRENT_USER, csPath, lRet
RegSetValueEx lRet, csValue, 0, REG_HEX, lData, 4
RegCloseKey lRet
Excel97MacroSecurity = True
Exit Function
ErrFailed:
Debug.Print Err.Description
Excel97MacroSecurity = False
End Function
'Purpose :Enables or disables the macro virus alert by altering the security level in the registry.
'Inputs :lSecurityLevel 1, sets security to "Low" (disable virus alerts)
' 2, sets security to "Medium"
' 3, sets security to "High"
' 4, sets security to "High" and disables access to VB Object Model
' AppType The application to set the security for.
' OfficeVersion The installed version of Office.
'Outputs : Returns True on success
'Author : Andrew Baker (
www.vbusers.com)
'Date : 25/11/2000 03:33
'Notes : Requires Excel 2000
'Revisions :
Function OfficeMacroSecurity(lSecurityLevel As Long, AppType As eApplication, OfficeVersion As eVersion) As Boolean
Dim sData As String, lRet As Long, sAppKey As String
Const cs****** As String = "Software\Microsoft\Office\[VERSION]\[APPLICATION]\Security"
Const csKeyVBOM As String = "AccessVBOM", csKey As String = "Level"
If lSecurityLevel <= 4 And lSecurityLevel > 0 Then
On Error GoTo ErrFailed
Select Case OfficeVersion
Case eOffice2000
sAppKey = Replace$(cs******, "[VERSION]", "9.0")
Case eOfficeXP
sAppKey = Replace$(cs******, "[VERSION]", "10.0")
Case eOffice2003
sAppKey = Replace$(cs******, "[VERSION]", "11.0")
Case Else
Debug.Print "Invalid version"
Debug.Assert False
OfficeMacroSecurity = False
Exit Function
End Select
Select Case AppType
Case eExcel
sAppKey = Replace$(sAppKey, "[APPLICATION]", "Excel")
Case eOutlook
sAppKey = Replace$(sAppKey, "[APPLICATION]", "Outlook")
Case ePowerPoint
sAppKey = Replace$(sAppKey, "[APPLICATION]", "PowerPoint")
Case ePublisher
sAppKey = Replace$(sAppKey, "[APPLICATION]", "Publisher")
Case eWord
sAppKey = Replace$(sAppKey, "[APPLICATION]", "Word")
Case Else
Debug.Print "Invalid application"
Debug.Assert False
OfficeMacroSecurity = False
Exit Function
End Select
RegCreateKey HKEY_CURRENT_USER, sAppKey, lRet
'Set the registry key macro security reg key
If lSecurityLevel = 4 Then
'Set to high
RegSetValueEx lRet, csKey, 0, REG_HEX, 3, 4
Else
'Set to the specified level
RegSetValueEx lRet, csKey, 0, REG_HEX, lSecurityLevel, 4
End If
If lSecurityLevel < 4 Then
'Enable access to VB Object Model
RegSetValueEx lRet, csKeyVBOM, 0, REG_HEX, 1, 4
Else
'Disable access to VB Object Model
RegSetValueEx lRet, csKeyVBOM, 0, REG_HEX, 0, 4
End If
RegCloseKey lRet
OfficeMacroSecurity = True
Else
Debug.Print "Invalid Security Level"
Debug.Assert False
End If
Exit Function
ErrFailed:
Debug.Print Err.Description
OfficeMacroSecurity = False
End Function
Tồi có 1 file baocao.xls (nằm ồ D) và 1 file kt.xls (nằm ô C và khong có dữ liệu). Tôi muốn khi tôi clik chạy file baocao.xls thì mặc nhiên sẽ kiểm tra xem có tồn tại file kt.xls không, nếu có thì file Baocao.xls báo là kết nối thành công và chạy bình thường, còn nếu không tồn tại file này báo là kết nối không thành công và đóng file baocao.xls lai luôn.
pen (để code tự chạy khi khởi động file)
