[英]How can I open each word document in my file and extract data to put into a cell in Excel VBA
At work I have to go into over 400 files individually and grab the subject of the word document and the date it was written (this is found within the report) and put that into an excel list.在工作中,我必须单独进入 400 多个文件,并获取 word 文档的主题和编写日期(在报告中找到)并将其放入 Excel 列表中。 I've found code to search through a word document and get this data which is working but I've been playing around with it and I can't get it to loop through all files in a folder.我找到了搜索word文档并获取正在工作的数据的代码,但我一直在玩它,但我无法让它循环浏览文件夹中的所有文件。 Right now I can only do one file at a time which isn't ay faster than doing it by hand.现在我一次只能做一个文件,这并不比手工做快。
The code gets the subject and puts it in a cell.代码获取主题并将其放入单元格中。
Ideally the code would display the file that it took the data from in one cell and in the cell beside it, it would display the subject.理想情况下,代码将在一个单元格中显示它从中获取数据的文件,并在其旁边的单元格中显示主题。
A video I watched said to loop through I need to use a dir function but I can't get that to work the way I'm doing it.我观看的视频说循环播放我需要使用 dir 函数,但我无法按照我的方式工作。
This is the code that I have that takes one file at a time.这是我拥有的代码,一次获取一个文件。
Sub ExtractText()
Dim cDoc As Word.Document
Dim cRng As Word.Range
Dim i As Long
i = 2
Dim wordapp As Object
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open "c:\code practice\file1"
wordapp.Visible = True
Set cDoc = ActiveDocument
Set cRng = cDoc.Content
With cRng.Find
.Forward = True
.Text = "SUBJECT:"
.Wrap = wdFindStop
.Execute
Do While .Found
'Collapses a range or selection to the starting or ending position
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
cRng.MoveEndUntil Cset:="INSPEC"
Cells(i, 1) = cRng
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
.Execute
i = i + 1
Loop
End With
wordapp.Quit
Set wordapp = Nothing
End Sub
This FileSystemObject
will help you iterate.此FileSystemObject
将帮助您进行迭代。 I didn't want to mess too much with your existing code, so this may not be the fastest or most direct route.我不想过多地使用您现有的代码,因此这可能不是最快或最直接的路线。 I would encourage you to play with this in the future.我会鼓励你在未来玩这个。
Option Explicit
Sub IterateMSWordExtracts()
Dim I As Integer
Dim FSO As Object
Dim DocumentFolder As Object
Dim oFile As Object
Set FSO = CreateObject("Scripting.filesystemobject")
Set DocumentFolder = FSO.GetFolder("FOLDER CONTAINING ALL FILES")
For Each oFile In DocumentFolder.Files
Debug.Print oFile.Path
If Right(oFile.Path, 4) = "docx" Then
ExtractText oFile.Path
End If
Next oFile
End Sub
Sub ExtractText(DocumentDirectory As String)
Dim cDoc As Word.Document
Dim cRng As Word.Range
Dim I As Long
I = 2
Dim wordapp As Object
Set wordapp = CreateObject("word.Application")
wordapp.Documents.Open DocumentDirectory
wordapp.Visible = True
Set cDoc = ActiveDocument
Set cRng = cDoc.Content
With cRng.Find
.Forward = True
.Text = "SUBJECT:"
.Wrap = wdFindStop
.Execute
Do While .Found
'Collapses a range or selection to the starting or ending position
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
cRng.MoveEndUntil Cset:="INSPEC"
Cells(I, 1) = cRng
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
.Execute
I = I + 1
Loop
End With
wordapp.Quit
Set wordapp = Nothing
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.