如何判斷一個檔案內是否包含宏﹖﹖﹖

lirong

請教:如何判斷一個檔案內是否包含宏﹖﹖﹖謝謝

fanlei

安全性設置為中級,如檔案包含宏,開啟文件時就會提示:是否開啟宏?
不過小弟有點難以置信,樓主問的真的是這個意思嗎??

lirong

不是你所說的﹐我是需有用VBA代碼來判斷﹐有的話我就用特殊手段移除。成千個文檔一個一個看﹐我豈不是要累死了。

夜半传说

Originally posted by lirong at 050621 11:02 AM:
不是你所說的﹐我是需有用VBA代碼來判斷﹐有的話我就用特殊手段移除。成千個文檔一個一個看﹐我豈不是要累死了。

Sub test()
    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
                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
            Next vaItem
        End If
    End With
End Sub

lirong

謝謝你﹐夜半传说﹐名字夠酷﹐技朮夠酷哦。

HOmT398

Originally posted by 夜半传说 at 2005-6-21 19:41:




Sub test()
    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 Workbo ...

谢谢夜半兄的代码.下载学习ing......

zyg365

出现错误提示：用户定义类型未定义
Dim fd As FileDialog
请指教！

jasonzhaoping

原帖由 zyg365 于 2006-9-21 09:29 发表
出现错误提示：用户定义类型未定义
Dim fd As FileDialog
请指教！

xp可用，E2000不可用，其它不知道。

问题好，代码更好！！！收藏学习！

Emily

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


               If wb.VBProject.Protection = 1 Then    ' 判斷vbe是否保護
                    MsgBox "檔案" & Dir(vaItem) & " VBA 專案被鎖定"
                    wb.Close 0

               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

            End If
            Next vaItem
        End If
    End With
End Sub


'  当档案有工程密码是,出错 , amended on 30 Jul 2006
http://cat14051.mysinablog.com/index.php?op=ViewArticle&articleId=210827

[ 本帖最后由 Emily 于 2006-9-21 11:27 编辑 ]

danis

看看這個：
Function CheckVba(ByVal FileName As String) As Boolean
     Dim Handle   As Integer
     Dim FileText As String
     If Len(Dir$(FileName)) = 0 Then Err.Raise 53
     Handle = FreeFile
     Open FileName$ For Binary As #Handle
          FileText = Space$(LOF(Handle))
          Get #Handle, , FileText
     Close #Handle
     CheckVba = IIf(InStr(FileText, "&H00000001") <> 0, True, False)
   End Function

StanleyPan

原帖由 danis 于 2006-10-6 17:02 发表
看看這個：
Function CheckVba(ByVal FileName As String) As Boolean
     Dim Handle   As Integer
     Dim FileText As String
     If Len(Dir$(FileName)) = 0 Then Err.Raise 53
     Handle = FreeF ...

相当好!对EXCEL的格式要相当了解才能做到这一些.

不过,好象并不完全正确.

[ 本帖最后由 StanleyPan 于 2006-10-7 16:36 编辑 ]

danis

把"&H00000001"換成"Name=" "CMG="

HOmT398

原帖由 danis 于 2006-10-9 18:58 发表
把"&H00000001"換成"Name=" "CMG="

不明,2个字符串??

Emily

原帖由 HOmT398 于 2006-10-9 19:09 发表


不明,2个字符串??

Excel file in Binary example:


ID="{87EEB809-E9F0-11D6-95A2-008888998168}"
Document=ThisWorkbook/&H00000000
Document=Sheet1/&H00000000
Module=Module1
Name="VBAProject"
HelpContextID="0"
VersionCompatible32="393222000"
CMG="DBD91940F044F044F044F044"
DPB="B6B474AD94536E546E546E"
GC="91935354545454AB"


遺漏 &H00000001
..
..
..
&H00000001={3832D640-CF90-11CF-8E43-00A0C911005A};VBE;&H00000000

[ 本帖最后由 Emily 于 2006-10-10 00:53 编辑 ]

HOmT398

原帖由 Emily 于 2006-10-10 00:46 发表
Excel file in Binary example:
ID="{87EEB809-E9F0-11D6-95A2-008888998168}"
Document=ThisWorkbook/&H00000000
Document=Sheet1/&H00000000
Module=Module1
Name="VBAPro ...

意思是通过Excel的二进制码来达到目的
但还是不是很理解,为什么Danis给出的自定义函数没试成功??
不会是多了个"Option Explicit" 的问题吧...

Emily

Sub Test()

MsgBox CheckVba("C:\xxx\yyy.xls")

End Sub

HOmT398

原帖由 Emily 于 2006-10-10 10:36 发表
Sub Test()
MsgBox CheckVba("C:\xxx\yyy.xls")
End Sub

Hi, Emily
曾经向Danis反映过
对于空的Excel文件,返回值也是True
奇怪了

keanjeason

原帖由 HOmT398 于 2006-10-10 11:10 发表


Hi, Emily
曾经向Danis反映过
对于空的Excel文件,返回值也是True
奇怪了

呵呵，没有宏的Excel文件也为True，还是有问题
思路不错

记得以前见过一个叫OpenOffice.org的机构在做“Microsoft Excel File Format”的研究，还没有完成。
里面对Excel文件 的结构形式进行探讨，我见到的那个已经完成了Introduction、Document Structure、Common Record Substructures和Formulas的一部分，Worksheet/Workbook Structure、Worksheet/Workbook Records、Drawing Objects, Escher Layer、Charts、PivotTables、Change Tracking等均未完成或尚未开始。

有兴趣的可以看看，搜索一下 excelfileformat.pdf

[ 本帖最后由 keanjeason 于 2006-10-10 11:49 编辑 ]

HOmT398

原帖由 keanjeason 于 2006-10-10 11:26 发表
呵呵，没有宏的Excel文件也为True，还是有问题
思路不错

记得以前见过一个叫OpenOffice.org的机构在做“Microsoft Excel File Format”的研究，还没有完成。
里面对Excel文件 的结构形式进行探讨，我见 ...

我找..再找...
现在就缺
Drawing Objects, Escher Layer、Charts、PivotTables、Change Tracking等均未完成或尚未开始。
可惜仅有E文,需要功底

Emily

Excel 97 Chart Format