用VBA代码打开xls文件时，判断被打开的xls文件是否含VBA代码并禁止其运行

说明

本文为原创，引用请注明出处，谢谢！

需求背景

公司在迁移质控体统的文件控件系统，新文控系统不支持老版的office文件(xls, doc, ppt等), 需要将其升版成新的xlsx, docx, pptx格式。
显然，用vba代码处理是最便捷的。只要打开原文件，另存为新格式，再删除旧文件就行了。
但是在执行时，发现一个问题，就是老版的office文件，含不含vba代码(宏macro)，其文件后缀是一样的。有些文件的vba代码中文件打开、文件保存会触一些功能。因此需要禁止被打开文件中的vba被触发运行。另一方面，因为新版office中带有vba代码的文件，其后缀是不一样的(xlsm, docm, pptm), 所以需要根据原文件中是否含vba代码来决定升级成相应类型的文件。

禁止被打开文件中的vba运行

这个相对简单，只需要设置application对象的AutomationSecurity 属性就可以了，Excel, Word, PowerPoint都一样。
这个属性有3个选项：

• msoAutomationSecurityLow
• msoAutomationSecurityByUI
• msoAutomationSecurityForceDisable

实际上这是预定义的常量，从上到下分别是1,2,3。
在打开文件前，将属性设为 msoAutomationSecurityForceDisable 即可.
当然，考究一点，可以先保存当前的设置，然后在最后再恢复。

处理之前:

intPreviousSetting = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable 'Excel
objWordApp.AutomationSecurity = msoAutomationSecurityForceDisable 'Word
objPowerPointApp.AutomationSecurity = msoAutomationSecurityForceDisable 'PowerPoint```

处理完毕:

Application.AutomationSecurity = intPreviousSetting

判断打开的文件中是否含vba代码

这个略曲折。需要利用office 文件对象中VBProject对象下的VBComponents对象综合处理。

• 先取得打开的文件中有多少个components

  这里的 components, 就是VBE编辑器中左侧对象列表中的对象。如下图，test.xlsx 文件有2个对象，分别是"ThisWorkbook"和"Sheet1", 另一个xlsm文件有3个对象，多了一个"Modules1"
  
  这个数量可以用count属性获取:

  	intObjects = objExcelFile.VBProject.VBComponents.Count` 
  

• 利用取得的对象数量, 取得每个对象中的代码行数

  在VBComponents对象下, 有个Item对象，每个item就对应一个具体的Component对象。Component对象下有个CodeModule对象，可以利用它的CountOfLines属性，来取得该模块中有多少行代码。如果代码行数不为0，则说明文件中有VBA代码。

  'Has vba code or not
  blNoMacro = False
  For intTemp = 1 To objExcelFile.VBProject.VBComponents.Count   'How many objects
          If objExcelFile.VBProject.VBComponents.Item(intTemp).CodeModule.CountOfLines > 0 Then
              blNoMacro = True
              Exit For
          End If
      Next
  'save file
  objExcelFile.SaveAs IIf(blNoMacro, strPath & "\" & strFileName & ".xlsm", strPath & "\" & strFileName & ".xlsx")
  

• 需要注意的几个问题:

1. 对于Excel 文件，即使完全没有VBA代码，也会有2个components：Workbook" 和"Sheet1"; 对word, 会有1个：“ThisDocument”; 对于PowerPoint, 如果没有VBA代码，则component个数为0
2. 对于模块中的空行, CountOfLines 也会统计在内。极端情况下，用户只是输入了些回车，并没有实质性代码，用这个方法也会被判定为含宏。如果确实要求非常精确，可以用类似的手段，取得每一行代码，判断是否为空。但这样会非常耗时，对于此项目并不需要到这么精确，所以就只做简单判断了。
3. 使用这个方法的，需要在Word/Excel/PowerPoint中开启"Trust Access to the VBA project object model". 开启的方法与允许运行宏一样，都在信任中心那里设置
   
   否则的话，会收到如下提示：
   

附完整代码

Option Explicit
Sub test()
    'Excel
    Dim objExcelFile As Workbook
    
    'Word
    Dim objWordApp As New Word.Application, objWordDoc As Word.Document
    
    'PowerPoint
    Dim objPptApp As New PowerPoint.Application, objPptFile As PowerPoint.Presentation
    
    Dim strPath As String, strFileName As String, strNewFileName As String, intTemp As Integer, blNoMacro As Boolean
    
    objWordApp.Visible = True
    objPptApp.Visible = msoCTrue
    
    'Disable vba running
    Application.AutomationSecurity = msoAutomationSecurityForceDisable 'msoAutomationSecurityLow  '=msoAutomationSecurityByUI =  'msoAutomationSecurityForceDisable
    objWordApp.AutomationSecurity = msoAutomationSecurityByUI ' = msoAutomationSecurityForceDisable
    objPptApp.AutomationSecurity = msoAutomationSecurityForceDisable
    
    'open excel file
    strPath = "C:\temp"
    strFileName = "test"
    Set objExcelFile = Application.Workbooks.Open(strPath & "\" & strFileName & ".xls")
    
    'Has vba code or not
    blNoMacro = False
    For intTemp = 1 To objExcelFile.VBProject.VBComponents.Count   'How many objects
        If objExcelFile.VBProject.VBComponents.Item(intTemp).CodeModule.CountOfLines > 0 Then
            blNoMacro = True
            Exit For
        End If
    Next
    'Save file
    objExcelFile.SaveAs IIf(blNoMacro, strPath & "\" & strFileName & ".xlsm", strPath & "\" & strFileName & ".xlsx")
    '......
    objExcelFile.Close
    
    
    'open word file
    Set objWordDoc = objWordApp.Documents.Open(strPath & "\" & strFileName & ".doc")
    'Has vba code or not
    blNoMacro = False
    For intTemp = 1 To objWordDoc.VBProject.VBComponents.Count   'How many objects
        If objWordDoc.VBProject.VBComponents.Item(intTemp).CodeModule.CountOfLines > 1 Then
            blNoMacro = True
            Exit For
        End If
    Next
    'save file
    objWordDoc.SaveAs2 IIf(blNoMacro, strPath & "\" & strFileName & ".docm", strPath & "\" & strFileName & ".docx")
    objWordDoc.Close
    
    'open ppt file
    Set objPptFile = objPptApp.Presentations.Open(strPath & "\" & strFileName & ".ppt")
    'Has vba code or not
    blNoMacro = False
    For intTemp = 1 To objPptFile.VBProject.VBComponents.Count   'How many objects
        If objPptFile.VBProject.VBComponents.Item(intTemp).CodeModule.CountOfLines > 0 Then
            blNoMacro = True
            Exit For
        End If
    Next
    'save file
    objPptFile.SaveAs IIf(blNoMacro, strPath & "\" & strFileName & ".pptm", strPath & "\" & strFileName & ".pptx")
    objPptFile.Close
    
EXIT_SUB:
    Set objExcelFile = Nothing
    Set objWordApp = Nothing
    Set objWordDoc = Nothing
    Set objPptApp = Nothing
    Set objPptFile = Nothing
    
End Sub

结语

VBA目前已经势微，准确地说，可能从来没有火过。但是事实上，这真的是一门极其有用的语言。如果能够掌握，在日常工作中会带来巨大的便利。相信你能看到这里，说明你正在使用它并遇到了困难要解决，希望此文能帮上。