VBA-Excel-通过文件夹中的多个文件搜索多个字符串 [英] VBA - Excel - Search multiple string through multiple files in a folder
问题描述
我从VBA和编程开始.
I begin with VBA and programmation.
我有一个带有X值的电子表格.每个值都与文件夹中的.xml文件匹配(或不匹配)(该值出现在xml标题中).我需要的是,对于这些值中的每一个,我的程序都搜索一个匹配的.xml文件,并在电子表格中的值旁边写上找到"或未找到".
I have a spreadsheet with X values. Each of this values match (or not) with an .xml file in a folder (the value is present in the xml title). What I need is that for each of these values my program search a matching .xml file and write "found" or "not found" next to the value in the spreadsheet.
到目前为止,我的代码:
My code so far :
Sub StringExistsInFile()
Dim theString As String
Dim path As String
Dim StrFile As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim line As String
theString = Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 2).Value
path = "C:\Users\Jira\Desktop\LaPoste\20170324_120939_export_phila_commande.Envoi1\"
StrFile = Dir(path & "*.xml")
i = 1
Do While StrFile <> ""
Set file = fso.OpenTextFile(path & StrFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, theString, vbTextCompare) > 0 Then
Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 14).Value = "found"
i = i + 1
Exit Do
End If
Loop
file.Close
Set file = Nothing
Set fso = Nothing
StrFile = Dir()
Loop
End Sub
感谢您的帮助.
值如何在电子表格中存储:
How the value are store in the spreadsheet :
蓝色=我搜索的值.红色=我要写找到"或找不到"的地方.
In blue = the values I search. In red = where I want to write "found" or "not found".
改进"之后有我的代码
Sub StringExistsInFile()
Dim theString As String
Dim path As String
Dim StrFile As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim line As String
theString = Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 2).Value
path = "C:\Users\Jira\Desktop\LaPoste\20170324_120939_export_phila_commande.Envoi1\"
StrFile = Dir(path & "*.xml")
i = 1
Do While Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 2).Value <> ""
Set file = fso.OpenTextFile(path & StrFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, theString, vbTextCompare) > 0 Then
Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 14).Value = "found"
Else
Sheets("PHILA_RESULT_PART_201703210429").Cells(i + 1, 14).Value = "not found"
End If
Loop
i = i + 1
file.Close
Set file = Nothing
StrFile = Dir()
Loop
设置fso =无效结束
Set fso = Nothing End Sub
推荐答案
我认为存在逻辑缺陷:只要当前打开文件的当前行与 theString
相匹配,您的 Exit Do
停止读取该文件,但随后您继续检查其他文件并更新行索引
I think there's a logic flaw: as long as current open file current line matches theString
, your Exit Do
stops reading that file but you then keep checking other files and updating row index
我建议您对代码进行以下(注释)重构:
I'd propose you the following (commented) refactoring of your code:
Option Explicit
Sub StringsExistInFiles()
Dim path As String
Dim fso As FileSystemObject
Dim filesPath As Variant
Dim cell As Range
Set fso = New FileSystemObject
path = "C:\Users\Jira\Desktop\LaPoste\20170324_120939_export_phila_commande.Envoi1\"
If Not GetFilesWithGivenExtension(fso, path, "xml", filesPath) Then Exit Sub '<--| exit if no files with given extension in given path
With Sheets("PHILA_RESULT_PART_201703210429") '<--| reference your sheet
For Each cell In .Range("B2", .Cells(.Rows.count, 2).End(xlUp)) '<--| loop through its column "B" cells from row 2 down to last not empty one
StringExistsInFiles fso, filesPath, cell '<--| check all files for the exitence of the current cell content and write the result in corresponding column N cell
Next
End With
End Sub
Sub StringExistsInFiles(fso As FileSystemObject, filesPath As Variant, cell As Range)
Dim line As String
Dim filePath As Variant
Dim found As Boolean
With fso '<--| reference passed FileSystemObject
For Each filePath In filesPath '<--| loop through all passed paths
With .OpenTextFile(filePath) '<--| reference current path file
Do While Not .AtEndOfLine '<--| loop until referenced file last line
line = .ReadLine '<--| read referenced file current line
If InStr(1, line, cell.Value, vbTextCompare) > 0 Then '<--| if passed string is found in referenced file current line
found = True '<--| mark you made it
Exit Do '<--| stop reading referenced file further lines
End If
Loop
.Close '<--| close referenced file
If found Then Exit For '<--| if you made it then stop reading further files
End With
Next
cell.Offset(, 12).Value = IIf(found, "found", "not found")
End With
End Sub
Function GetFilesWithGivenExtension(fso As FileSystemObject, folderToSearch As String, extensionToFind As String, files As Variant) As Boolean
Dim fsoFile As file
Dim nFiles As Long
With fso.GetFolder(folderToSearch) '<--| reference passed folder
ReDim files(1 To .files.count) '<--| size paths array to the number of files in referenced folder
For Each fsoFile In .files '<--| loop through referenced folder files
If fso.GetExtensionName(fsoFile) = extensionToFind Then '<--| if current file extension matches passed one
nFiles = nFiles + 1 '<--| update valid files counter
files(nFiles) = fsoFile.path '<--| store current valid file path in paths array
End If
Next
End With
If nFiles > 0 Then '<--| if any valid file found
ReDim Preserve files(1 To nFiles) '<--| resize paths array correspondingly
GetFilesWithGivenExtension = True '<--| return successful result
End If
End Function
这篇关于VBA-Excel-通过文件夹中的多个文件搜索多个字符串的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!