Sub Check_VBA_Exist()
Dim fd As FileDialog
Dim FFs As FileDialogFilters
Dim stFileName As String
Dim vaItem
Dim VBC As Object
Dim HasCode As Boolean
Dim wb As Workbook
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
Set FFs = .Filters
With FFs
.Clear
.Add "Excel文件", "*.xls;*.xla"
End With
.AllowMultiSelect = True
If .Show = -1 Then
For Each vaItem In .SelectedItems
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wb = Workbooks.Open(vaItem)
HasCode = False
' 当档案有工程密码是,出错 , amended on 30 Jul 2006
If wb.VBProject.Protection = 1 Then ' 判斷vbe是否保護
MsgBox "檔案" & Dir(vaItem) & " VBA 專案被鎖定"
wb.Close 0
' Exit Sub
' End If
Else
For Each VBC In wb.VBProject.VBComponents
If VBC.Type <> 100 Then
HasCode = True: Exit For
ElseIf VBC.CodeModule.CountOfDeclarationLines < VBC.CodeModule.CountOfLines Then
HasCode = True: Exit For
End If
Next
If HasCode = True Then
MsgBox "檔案" & Dir(vaItem) & " 有宏"
Else
MsgBox "檔案" & Dir(vaItem) & " 無宏"
End If
wb.Close 0
Application.EnableEvents = True
Application.ScreenUpdating = True
