Ich habe etwa 100 Makros in einem Ordner, und ich bin auf der Suche nach einer, die ein VBA-Modul mit der Funktion addGBE
enthält - ich vergesse, in welcher Datei es ist. Gibt es ein Softwareprogramm, mit dem ich innerhalb des VBA-Codes von Dateien in einem bestimmten Ordner suchen kann?Suche VBA-Code über mehrere Excel-Dateien
0
A
Antwort
0
Ich habe einen alten Code (2006) gefunden, den ich aktualisiert habe. Es wird ein Feld zum Eingeben der Suchzeichenfolge geöffnet und dann ein Dialogfeld zum Auswählen des Ordners geöffnet. Es durchsucht dann alle Module und zeigt eine msgbox an, die den Dateinamen und den Namen des Blatt/Moduls anzeigt, in dem die Zeichenfolge gefunden wurde. Ich habe das nicht gemacht, nur aktualisiert. Orig gefunden here. Informationen zur Microsoft-Dokumentation finden Sie unter here, wenn Sie nach 64-Bit suchen und Datentypen ordnungsgemäß deklarieren.
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
Verwandte Themen
- 1. Suche über mehrere Tabellen
- 2. Suche über mehrere Spalten
- 3. Rails Suche über mehrere Modelle
- 4. SQL Query - Suche über mehrere Felder
- 5. Regex mit sed, Suche über mehrere Zeilen
- 6. über mehrere Tabellen Suche (best practices)
- 7. Suche nach einem Schlüsselwort über mehrere Spalten
- 8. Relevanz Suche über mehrere verwandte Tabellen
- 9. scikit Grid Suche über mehrere Klassifikatoren python
- 10. Ember JS - Suche über mehrere Modelle?
- 11. Elasticsearch Suche über mehrere Indizes - ignoriert nicht-vorhandenen Indizes
- 12. Zurück Neo4J Kombinierte Beziehungen bei der Suche über mehrere Beziehungstypen
- 13. Python - Suche nach Dateien & ZIP, über mehrere Verzeichnisse hinweg
- 14. Suche mehrere Dateien für mehrere Wörter
- 15. Schnelle Text Suche über Logs
- 16. vim: Suche ersetzen über alle beschreibbaren Puffer
- 17. jQuery DataTable mehrere Wert Suche
- 18. Suche einer Datei, mehrere Vorkommen
- 19. Suche mehrere Tabellen in Abfrage
- 20. Suche mehrere AD DN mitPHP
- 21. Suche Listenansicht Auswahlmodus mehrere Ereignisse
- 22. Suche über zwei Lucene-Dokumente
- 23. Suche über Felder in Lucene
- 24. Suche über $ .getJSON funktioniert nicht?
- 25. Windows-Desktop-Suche über C#
- 26. Strategien für die Suche über verschiedene Datenquellen
- 27. Hive Fensterfunktionen über mehrere Datumsbereiche
- 28. mehrere json über php
- 29. Wischen über mehrere Tabellenansichten
- 30. Medienanfragen über mehrere Rahmen
Sind alle BA-Dateien? Wenn ja, können Sie alle nach '.txt' kopieren/umbenennen und dann den Ordner durchsuchen. Das ist vielleicht der schnellste Weg. Sie können sogar VBA verwenden, um jede Datei zu kopieren/umzubenennen. – BruceWayne
Wenn sich der gesamte Code in Dateien '.bas',' .txt', '.doc' (oder anderen Dateien mit dem unverschlüsselten Textformat) befindet, können Sie die Windows-Suche verwenden, um Ihren Code zu finden (keine Umbenennung erforderlich). Es gibt viele Seiten, die erklären, wie man das macht http://answers.microsoft.com/en-us/windows/forum/windows_7-files/in-windows-7-i-want-to-search-for-all-files/ aadfe1f1-4a33-406b-8e72-bb920efa4f30? auth = 1. Wenn Ihnen die Windows-Suche nicht gefällt, können Sie auch Tools wie http://stackoverflow.com/questions/317944/tools-to-search-for-strings-inside-files-without-indexing verwenden. – Ralph