在Microsoft Office和其他压缩文件中显示 Windows搜索

Question

我在一个文件夹中有大约100个宏，我正在寻找一个特别包含VBA模块的宏，其中包含一个名为addGBE的函数 - 我忘记了它的文件。是否有任何软件程序允许我在特定文件夹中的文件的VBA代码中进行搜索？

Answer 1

我找到了一些旧的代码（2006），我已经更新了。它将打开一个框以输入搜索字符串，然后打开一个dir对话框以选择文件夹。然后它将搜索所有模块并显示一个msgbox，显示文件名和工作表/模块名称，其中找到了字符串。我没有做到这一点，只是更新了。 Orig找到here。有关检查64位和正确声明数据类型的Microsoft文档，请参阅here。

    Option Explicit


#If VBA7 And Win64 Then    ' VBA7
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long


Public Type BROWSEINFO
  hOwner As LongPtr
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As LongPtr
  lParam As LongPtr
  iImage As Long
End Type

#Else    ' Downlevel when using previous version of VBA7

Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long


Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
#End If


Function GetDirectory(Optional Msg) As String

Dim bInfo As BROWSEINFO
Dim Path As String
Dim R As Long
Dim x As Long
Dim pos As Integer

'Root folder (&H0 for Desktop, &H11 for My Computer)
bInfo.pidlRoot = &H0

'Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
Path = Space$(512)
R = SHGetPathFromIDList(ByVal x, ByVal Path)
If R Then
pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, pos - 1)
Else
GetDirectory = ""
End If

End Function

Function RecursiveFindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean = True, _
Optional bSheet As Boolean = False, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As Variant

'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Long 'Number of directories in this strPath.
Dim i As Long 'For-loop counter.
Dim n As Long
Dim arrFiles
Static strStartDirName As String
Static strpathOld As String

On Error GoTo sysFileERR

If lFileCount = 0 Then
Static collFiles As Collection
Set collFiles = New Collection
Application.Cursor = xlWait
End If

If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
strStartDirName = strPath
End If

'search for subdirectories
'-------------------------
nDir = 0

ReDim arrDirNames(nDir)

strDirName = Dir(strPath, _
vbDirectory Or _
vbHidden Or _
vbArchive Or _
vbReadOnly Or _
vbSystem) 'Even if hidden, and so on.

Do While Len(strDirName) > 0
'ignore the current and encompassing directories
'-----------------------------------------------
If (strDirName <> ".") And (strDirName <> "..") Then
'check for directory with bitwise comparison
'-------------------------------------------
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
DoEvents
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont1:
End If
strDirName = Dir() 'Get next subdirectory

DoEvents
Loop

'Search through this directory
'-----------------------------
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) <> 0

'dump file in sheet
'------------------
If bSheet Then
If lFileCount < 65536 Then
Cells(lFileCount + 1, 1) = strPath & strFileName
End If
End If

lFileCount = lFileCount + 1

collFiles.Add strPath & strFileName

If strPath <> strpathOld Then
Application.StatusBar = " " & lFileCount & _
" " & strSearch & " files found. " & _
"Now searching " & strPath
End If

strpathOld = strPath

strFileName = Dir() 'Get next file

DoEvents
Wend

If bSubFolders Then
'If there are sub-directories..
'------------------------------
If nDir > 0 Then
'Recursively walk into them
'--------------------------
For i = 0 To nDir - 1
RecursiveFindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSubFolders, _
bSheet, _
lFileCount, _
lDirCount

DoEvents
Next
End If 'If nDir > 0

'only bare main folder left, so get out
'--------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If

Else 'If bSubFolders
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If 'If bSubFolders

Exit Function
sysFileERR:

Resume sysFileERRCont1

End Function

Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean = False) _
As String

Dim FPL As Long 'len of full path
Dim PLS As Long 'position of last slash
Dim pd As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

FPL = Len(strFullPath)
PLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, FPL - PLS)

If bExtensionOff = False Then
FileFromPath = strFile
Else
pd = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPath = Left$(strFile, pd - 1)
End If

Exit Function
ERROROUT:

On Error GoTo 0
FileFromPath = ""

End Function

Sub SearchWBsForCode()

Dim strTextToFind As String
Dim strFolder As String
Dim arr
Dim i As Long
Dim strWB As String
Dim VBProj As VBProject
Dim VBComp As VBComponent
Dim lStartLine As Long
Dim lEndLine As Long
Dim lFound As Long
Dim lType As Long
Dim lSkipped As Long
Dim oWB As Workbook
Dim bOpen As Boolean
Dim bNewBook As Boolean

strTextToFind = InputBox("Type the text to find", _
"finding text in VBE")

If Len(strTextToFind) = 0 Or StrPtr(strTextToFind) = 0 Then
Exit Sub
End If

strFolder = GetDirectory()

If Len(strFolder) = 0 Then
Exit Sub
End If

lType = Application.InputBox("Type file type to search" & _
vbCrLf & vbCrLf & _
"1. Only .xls files" & vbCrLf & _
"2. Only .xla files" & vbCrLf & _
"3. Either file type", _
"finding text in VBE", 1, Type:=1)

Select Case lType
Case 1
arr = RecursiveFindFiles(strFolder, "*.xls", True, True)
Case 2
arr = RecursiveFindFiles(strFolder, "*.xla", True, True)
Case 3
arr = RecursiveFindFiles(strFolder, "*.xl*", True, True)
Case Else
Exit Sub
End Select

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

For i = 1 To UBound(arr)

Application.StatusBar = i & "/" & UBound(arr) & _
" - Searching " & arr(i)

strWB = FileFromPath(arr(i))

On Error Resume Next
Set oWB = Workbooks(strWB)

If oWB Is Nothing Then
bOpen = False
Workbooks.Open arr(i)
Else
'for preventing closing WB's that are open already
bOpen = True
Set oWB = Nothing
End If

bNewBook = True

For Each VBComp In Workbooks(strWB).VBProject.VBComponents

If Err.Number = 50289 Then 'for protected WB's
lSkipped = lSkipped + 1
Err.Clear
GoTo PAST
End If

lEndLine = VBComp.CodeModule.CountOfLines
If VBComp.CodeModule.Find(strTextToFind, _
lStartLine, _
1, _
lEndLine, _
-1, _
False, _
False) = True Then

If bNewBook = True Then
lFound = lFound + 1
bNewBook = False
End If

Application.ScreenUpdating = True

If MsgBox("Workbook: " & arr(i) & vbCrLf & _
"VBComponent: " & VBComp.Name & vbCrLf & _
"Line number: " & lStartLine & _
vbCrLf & vbCrLf & _
"WB's found so far: " & lFound & vbCrLf & _
"Protected WB's skipped: " & lSkipped & _
vbCrLf & vbCrLf & _
"Stop searching?", _
vbYesNo + vbDefaultButton1 + vbQuestion, _
i & "/" & UBound(arr) & _
" - found " & strTextToFind) = vbYes Then

With Application
.StatusBar = False
.EnableEvents = True
.DisplayAlerts = True
End With

With VBComp.CodeModule.CodePane
.SetSelection lStartLine, 1, lStartLine, 1
.Show
End With

Exit Sub
End If

Application.ScreenUpdating = False

End If
Next

PAST:
If bOpen = False Then
Workbooks(strWB).Close savechanges:=False
End If
On Error GoTo 0

Next

On Error Resume Next
If bOpen = False Then
Workbooks(strWB).Close savechanges:=False
End If

With Application
.ScreenUpdating = True
.StatusBar = False
.EnableEvents = True
.DisplayAlerts = True
End With

MsgBox lFound & " WB's found with " & strTextToFind & " in VBE" & _
vbCrLf & vbCrLf & _
"protected WB's skipped: " & lSkipped, , _
"finding text in VBE"

End Sub

Answer 2

在Microsoft Office和其他压缩文件中显示 Windows搜索

从Microsoft Office 2007开始，Office Open XML (OOXML) file formats已成为默认文件格式。

File types，例如.XLSX，.XLSM和.DOCX使用XML体系结构和ZIP压缩将文本和公式之类的内容存储到单元格中分为行和列。例如，只需changing和.XLSM' file's extension to。ZIP`可以将其作为压缩文件打开，并查看构成Excel工作簿的文件。

通过调整一些设置，我们可以确保Windows搜索始终以OOXML和其他压缩文件格式进行搜索。

_{我的示例使用Windows 7，但是Windows 10具有等效的设置。}

指定应为哪些文件类型建立索引

按 + E 浏览到保存Office或压缩文件的文件夹。
按 Alt + T 打开Tools菜单，然后单击Folder Options

tools > folder options

指定始终在

中搜索的文件类型

转到Search标签
确保已选择Always search filenames and contents
确保选中Include compressed

folder options > Search tab

将更改应用于其他文件夹：

_{此时，您可以：}

重复对要更改这些选项的其他任何文件夹或，
转到View标签，然后单击Apply to Folders，使所有文件夹外观/行为类似于当前文件夹。

警告！ _{这会将当前文件夹设置的全部复制到所有其他文件夹，包括显示的列，排序顺序，视图等，因此请注意，您可能会丢失单个文件夹的唯一设置。}
_{我个人将花时间完全按照自己的喜好设置一个文件夹，然后单击即可在任何地方实现。}