使用vba，我需要在一个包含1000多本工作簿的文件夹中找到某个交易ID，然后打开它

我最近开始使用VBA代码，在网上搜索了几个小时的想法或帮助后，我遇到了一堵墙。 由于这个网站似乎得到了最好的回复，我想知道是否有人能帮我找到一个由三个字母组成的商业ID，这三个字母是：；VAL、DIV或LIF；然后是一系列的数字

我的想法是将交易ID键入一个单元格，例如C4，然后单击同一页上的一个按钮，在整个文件夹中搜索该交易ID，因为它们是非常唯一的，只有一个文件可能会打开两个

谢谢，让我知道你的想法，是否可能，我需要多长时间来写这段代码，我应该使用什么样的代码

编辑： 以下是我目前的代码：

  Private Sub CommandButton1_Click()

   Dim MyObj As Object, MySource As Object, file As Variant
    file = Dir("X:\Ops\Trades\Repository\")
    While (file <> "")
      If InStr(file, Cells(3, 4)) > 0 Then
         MsgBox "found " & file
         Exit Sub
      End If
     file = Dir
    Wend

    End Sub

Private子命令按钮1\u单击（）
Dim MyObj作为对象，MySource作为对象，文件作为变量
file=Dir（“X:\Ops\Trades\Repository\”）
While（文件“”）
如果InStr（文件，单元格（3，4））>0，则
MsgBox“找到”文件（&F）
出口接头
如果结束
file=Dir
温德
端接头

编辑： 我发现并编辑了一些代码，但是当我运行它时，它会使我的电脑崩溃

 'Definitions
  Dim MyPath As String, FilesInPath As String
  Dim MyFiles() As String, Fnum As Long
  Dim mybook As Workbook
  Dim CalcMode As Long
  Dim sh As Worksheet
  Dim ErrorYes As Boolean
  Dim CellSearchBook As Worksheet
  Dim strFile As String


  strFile = Application.GetOpenFilename
  Set CellSearchBook = Workbooks.Open(strFile).Sheets(1)
  CellRef = InputBox("Please enter Horseshoe Cell Reference to search for")
  MyPath = "F:\Ops\Trades\Files\"

  'If no files found
   FilesInPath = Dir(MyPath & "*.xls")
   If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
    End If

   'Array myfiles will be filled
    Fnum = 0
    Do While FilesInPath <> ""
    Fnum = Fnum + 1
    ReDim Preserve MyFiles(1 To Fnum)
    MyFiles(Fnum) = FilesInPath
    FilesInPath = Dir()
    Loop

    With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
     End With

     'Run through all files
     If Fnum > 0 Then
     For Fnum = LBound(MyFiles) To UBound(MyFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
        On Error GoTo 0

        If Not mybook Is Nothing Then

       On Error Resume Next
            Dim ws As Worksheet
            For Each ws In mybook.Worksheets

                If .ProtectContents = True Then
                With ws
                Application.ScreenUpdating = False

                    If InStr(1, ws.Range("K11").Value, CellRef, vbTextCompare) <> 0 Then
                    ws.Range("H1").Copy Destination:=CellSearchBook.Range("A10")
                    Application.CutCopyMode = False
                    Else
                    End If

                Else
                    ErrorYes = True
                End If
            End With

       If Err.Number > 0 Then
                ErrorYes = True
                Err.Clear
                'Close mybook without saving
                mybook.Close savechanges:=False
            Else
                'Save and close mybook
                mybook.Close savechanges:=True
            End If
            On Error GoTo 0
        Else
            'Not possible to open the workbook
            ErrorYes = True
        End If

        Next Fnum
   End If


   End Sub

”定义
将MyPath设置为字符串，将FileInPath设置为字符串
Dim MyFiles（）作为字符串，Fnum作为长度
将mybook设置为工作簿
暗淡的CalcMode与长
将sh设置为工作表
Dim ErrorYes作为布尔值
将搜索簿设置为工作表
作为字符串的Dim strFile
strFile=Application.GetOpenFilename
设置CellSearchBook=工作簿。打开（strFile）。工作表（1）
CellRef=InputBox（“请输入要搜索的马蹄形单元格引用”）
MyPath=“F:\Ops\Trades\Files\”
'如果找不到任何文件
FilesInPath=Dir（MyPath&“*.xls”）
如果FilesInPath=“”，则
MsgBox“未找到任何文件”
出口接头
如果结束
'将填充数组myfiles
Fnum=0
在文件输入路径“”时执行此操作
Fnum=Fnum+1
ReDim保留我的文件（1到Fnum）
MyFiles（Fnum）=FilesInPath
FilesInPath=Dir（）
环
应用
CalcMode=.Calculation
.Calculation=xlCalculationManual
.ScreenUpdate=False
.EnableEvents=False
以
'运行所有文件
如果Fnum>0，则
对于Fnum=LBound（MyFiles）到UBound（MyFiles）
设置mybook=Nothing
出错时继续下一步
设置mybook=Workbooks.Open（MyPath&MyFiles（Fnum））
错误转到0
如果不是的话，我的书什么都不是
出错时继续下一步
将ws设置为工作表
对于mybook.工作表中的每个ws
如果.ProtectContents=True，则
与ws
Application.ScreenUpdating=False
如果InStr（1，ws.Range（“K11”）.值，CellRef，vbTextCompare）为0，则
ws.Range（“H1”）.Copy Destination:=CellSearchBook.Range（“A10”）
Application.CutCopyMode=False
其他的
如果结束
其他的
ErrorYes=True
如果结束
以
如果错误编号>0，则
ErrorYes=True
呃，明白了
'关闭我的书本而不保存
mybook.Close savechanges:=False
其他的
'保存并关闭mybook
mybook.Close savechanges:=True
如果结束
错误转到0
其他的
'无法打开工作簿
ErrorYes=True
如果结束
下一个Fnum
如果结束
端接头

如果这对您有帮助，它将返回一个文件名数组：

Private Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

    'Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

    '   Error handler
NoFilesFound:
    GetFileList = False
End Function

私有函数GetFileList（FileSpec作为字符串）作为变量
'返回与FileSpec匹配的文件名数组
'如果找不到匹配的文件，则返回False
Dim FileArray（）作为变量
Dim FileCount为整数
将文件名设置为字符串
在出现错误时转到找不到文件
FileCount=0
FileName=Dir（FileSpec）
如果FileName=“”，则转到NoFilesFound
'循环，直到找不到更多匹配的文件
文件名“”时执行此操作
FileCount=FileCount+1
ReDim保留文件数组（1到文件计数）
FileArray（FileCount）=文件名
FileName=Dir（）
环
GetFileList=FileArray
退出功能
'错误处理程序
找不到文件：
GetFileList=False
端函数

您需要这样的东西（这是从我拥有的一些不同模块快速拼接而成的，因此可能无法开箱即用）：

---

同样，这并不能完全解决您的问题，但它确实为您提供了一个相当不错的起点

尝试一下。当你陷入困境时，寻求帮助。（在编写任何代码之前说你被卡住了不算！）交易ID是在文件名中还是在实际的单个文件中？您当前的代码是否找到任何文件？您当前的代码是否抛出任何错误？代码会查找文件，但交易ID在文件中，而不是在名称中。这是在Windows或Mac平台上进行的-搜索文件的方式不同…非常确定VBA不会允许您在不打开每个工作簿的情况下检查单元格值。对于1000个文件来说，这将是相当缓慢的。作为一个函数，它将走向何方？不是一个子程序吗？不过，谢谢，我遇到的主要问题是如何一个接一个地打开每个文件，这样我的电脑就不会崩溃，在它们同时打开的时候。上面的步骤将分别打开每个文件，然后在打开另一个文件之前将其关闭。它允许您识别一个文件夹，然后在文件夹中的所有excel文件中循环查找您的值。请注意，在For循环中，它打开工作簿，运行所需的任何内容，然后在转到下一个FileObj之前关闭它。循环浏览所有1000本工作簿可能需要很多时间，但一次只能打开一本。

Dim FolderObj, FSO, FileObj As Object
Dim FolderDialog As FileDialog
Dim FolderLocation As String
Dim Check As Boolean

'Create and run dialog box object

Set FolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
With FolderDialog
    .ButtonName = "Select"
    .AllowMultiSelect = False
    .InitialFileName = "C:\"
    .InitialView = msoFileDialogViewDetails

    If .Show = -1 Then
        FolderLocation = .SelectedItems.Item(1)
            Check = True
    Else
         Check = False
    End If

 End With

 'Check if user canceled dialog box
 'Exit if yes

 If Check = False Then

     MsgBox "No Folder Selected"

     Exit Sub

 End If

 'Create a File System Object to be the folder that was selected

 Set FSO = CreateObject("scripting.filesystemobject")

 Set FolderObj = FSO.getfolder(FolderLocation)

 Dim ExApp As Excel.Application
 Dim ExWbk As Workbook



 Set ExApp = New Excel.Application
 ExApp.Visibility = False 'Set the application visibility to false to speed it up and run in the background while it searches your workbooks

 For Each FileObj In FolderObj.Files

      If Right(FileObj.Name, 3) = "xls" Then

           Set ExWbk = ExApp.Workbooks.Open(FolderObj & "\" & FileObj.Name)

           'Some sort of search for the workbook
           'Some sort of return to your workbook

           ExWbk.Close

      end if
 Next