VBA在已关闭的工作簿中搜索价值? [英] VBA search closed workbook(s) for value?

问题描述

我正在尝试在一个文件夹(和子文件夹)中搜索所有excel工作簿中的值.

I am trying to search all excel workbooks in a folder (and sub folders) for a value.

我的excel工作簿所在的文件夹结构如下:

My folder structure where my excel workbooks are is like so:

destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\"

然后在我的存档文件夹中有各种子文件夹，例如

Then within my archive folder there are various sub folders like

+ 2017
- April
- May

+ 2016
- April
- May

工作簿的名称可能都不同，因此代码可能需要使用通配符* .xlsm

The names of the workbooks might all be different, so the code will need to probably use something like wildcards *.xlsm

这是我到目前为止所拥有的:

Here's what i have so far:

Sub Search()
Dim srcWorkbook As Workbook
    Dim destWorkbook As Workbook
    Dim srcWorksheet As Worksheet
    Dim destWorksheet As Worksheet
    Dim SearchRange As Range
    Dim destPath As String
    Dim destname As String
    Dim destsheet As String
    Set srcWorkbook = ActiveWorkbook
    Set srcWorksheet = ActiveSheet
    Dim vnt_Input As String

    vnt_Input = Application.InputBox("Please Enter Client Name", "Client Name")

    destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\"
    destname = "*.xlsm"


    On Error Resume Next
    Set destWorkbook = ThisWorkbook
    If Err.Number <> 0 Then
    Err.Clear
    Set wbTarget = Workbooks.Open(destPath & destname)
    CloseIt = True
    End If

    For Each c In wbTarget.Sheets(1).Range("A:Q") 'No need for the .Cells here

       If InStr(c, vnt_Input) > 0 Then 'vnt_Input is a variable that holds a string, so you can't put quotes around it, or it will search the string for "vnt_Input"

          MsgBox "Found"
       End If
    Next c

End Sub

每个工作簿中的范围应始终保持不变.

The ranges in each workbook should always stay the same.

我正在尝试一些简单的操作，例如在找到该值时显示一条消息.但是此刻，尽管工作簿中存在值，但我仍然没有结果/没有消息.

I am trying something simple, like display a message when the value is found. But at the moment, despite the value existing in the workbook i am getting no result/no message.

我在此行上得到一个对象必需的错误:

I get an object required error on this line:

For Each c In wbTarget.Sheets(1).Range("A:Q") 'No need for the .Cells here

请有人可以告诉我我要去哪里了吗?

Please can someone show me where i am going wrong?

我可以将每个循环的消息框更改为，以列出每个结果，如下所示:

Can i change the message box to a for each loop to list each result like so:

Dim i As Integer
For i = 20 To 100

For Each rngFound In rngFound

ThisWorkbook.ActiveSheet.Range("E" & i).Value = "1 Result found for " & rngFound & " in " & wbTarget.Path & "\" & wbTarget.Name & ", on row " & rngFound.Address

Next rngFound

Next i

所需结果

推荐答案

代码的设置方式无效.您不能将 Workbooks.Open()方法与通配符一起使用，因为它一次只能打开一个文件，并且不会搜索文件.有两种方法可以在目录中搜索我所知道的具有特定命名模式的文件.最简单的方法是使用 Dir() 函数，但这不会很容易地递归到子文件夹中.

The way your code is set up won't work. You cannot use the Workbooks.Open() method with a wildcard, as it will only open one file at a time and doesn't search for a file. There are two ways of searching through a directory for a file with a particular naming pattern that I know of. The easiest way is using the Dir() function, but this won't recurse into subfolders very easily.

第二种方法(在下面为您编码)是一种使用参考"添加参考.

The second way (coded out for you below) is a way of recursing through files and subfolders that uses the FileSystemObject. In order to use this, you will need to add a reference to your project to the Microsoft Scripting Runtime library. You add the reference via Tools->References.

还请注意，此方法使用 Range.Find() 方法在您的工作簿中查找客户端名称，因为它比当前查找客户端名称是否在工作表中的方法更容易理解.

Also note that this method uses the Range.Find() method to find the client name in your workbooks as it should be quicker and easier to understand than your current method of finding whether the client name is in the worksheet.

Option Explicit

Sub Search()

Dim myFolder As Folder
Dim fso As FileSystemObject
Dim destPath As String
Dim myClient As String

myClient = Application.InputBox("Please Enter Client Name", "Client Name")

Set fso = New FileSystemObject

destPath = "G:\WH DISPO\(3) PROMOTIONS\(18) Food Specials Delivery Tracking\Archive\"

Set myFolder = fso.GetFolder(destPath)

'Set extension as you would like
Call RecurseSubfolders(myFolder, ".xlsm", myClient)

End Sub

---

Sub RecurseSubfolders(ByRef FolderToSearch As Folder, _
           ByVal fileExtension As String, ByVal myClient As String)

Dim fileCount As Integer, folderCount As Integer
Dim objFile As File
Dim objSubfolder As Folder

fileCount = FolderToSearch.Files.Count
'Loop over all files in the folder, and check the file extension
If fileCount > 0 Then
  For Each objFile In FolderToSearch.Files
    If LCase(Right(objFile.Path, Len(fileExtension))) = LCase(fileExtension) Then
      'You can check against "objFile.Type" instead of the extension string,
      'but you would need to check what the file type to seach for is
      Call LookForClient(objFile.Path, myClient)
    End If
  Next objFile
End If

folderCount = FolderToSearch.SubFolders.Count
'Loop over all subfolders within the folder, and recursively call this sub
If folderCount > 0 Then
  For Each objSubfolder In FolderToSearch.SubFolders
    Call RecurseSubfolders(objSubfolder, fileExtension, myClient)
  Next objSubfolder
End If

End Sub

---

Sub LookForClient(ByVal sFilePath As String, ByVal myClient As String)

Dim wbTarget As Workbook
Dim ws As Worksheet
Dim rngFound As Range
Dim firstAddress As String
Static i As Long           'Static ensures it remembers the value over subsequent calls

'Set to whatever value you want
If i <= 0 Then i = 20

Set wbTarget = Workbooks.Open(Filename:=sFilePath)    'Set any other workbook opening variables as appropriate

'Loop over all worksheets in the target workbook looking for myClient
For Each ws In wbTarget.Worksheets
  With ws.Range("A:Q")
    Set rngFound = .Find(What:=myClient, LookIn:=xlValues, LookAt:=xlPart)

    If Not rngFound Is Nothing Then
      firstAddress = rngFound.Address

      'Loop finds all instances of myClient in the range A:Q
      Do
        'Reference the appropriate output worksheet fully, don't use ActiveWorksheet
        ThisWorkbook.Worksheets("SomeSheet").Range("E" & i).Value = _
                     "1 Result found for " & myClient & " in " & sFilePath _
                     & ", in sheet " & ws.Name & ", in cell " & rngFound.Address
        i = i + 1
        Set rngFound = .FindNext(After:=rngFound)
      Loop While (Not rngFound Is Nothing And rngFound.Address <> firstAddress)
    End If
  End With
Next ws

'Close the workbook
wbTarget.Close SaveChanges:=False

End Sub

这篇关于VBA在已关闭的工作簿中搜索价值?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！