Lấy dữ liệu từ nhiều file word để điền vào file excel

[sesongkhac]

Trước tiên cho tôi xin chào toàn thể diễn đàn mình.
Tôi có nhiều file word nằm cùng 1 folder.
Trong các file word đó có 1 dòng dữ liệu ( nằm cố định tại dòng thứ 4)
Giờ tôi lấy dữ liệu từ các file word đó để điền vào 1 cột trong file excel

Vì file word quá nhiều, cả ngàn file nên không thể làm thủ công được, mong các bạn giúp đỡ ạ, Cảm ơn ạ!

 

[huuthang_bd]

Đồng excel là đơn vị tiền tệ của nước nào vậy ta?
Chữ hoa - chữ thường, chính tả, dấu câu, tiếng lóng.

 

[sesongkhac]

Dạ. Em có sửa lại chính tả rồi ạ. Em cảm ơn. Sơ suất quá mong anh thông cảm.

 

[huuthang_bd]

Dạ. Em có sửa lại chính tả rồi ạ. Em cảm ơn. Sơ suất quá mong anh thông cảm.

Sub GetDataFromMSWordFiles()
Dim arrResult
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show Then
        arrResult = ReadMSWordFiles(.SelectedItems(1))
        Range("A1").Resize(UBound(arrResult, 1), 2).Value = arrResult
    End If
End With
End Sub


Private Function ReadMSWordFiles(ByVal sFolder As String) As Variant
Dim FSO As Object, iFile As Object, arrResult(1 To 65000, 1 To 2), iIndex
Set FSO = CreateObject("Scripting.FileSystemObject")
With CreateObject("Word.Application")
    .Visible = False
    For Each iFile In FSO.GetFolder(sFolder).Files
        If LCase(FSO.GetExtensionName(iFile)) & "x" Like "docx*" Then
            iIndex = iIndex + 1
            arrResult(iIndex, 1) = iFile
            With .Documents.Open(iFile.Path)
                arrResult(iIndex, 2) = .Paragraphs(4).Range.Text
                .Close False
            End With
        End If
    Next
    .Quit
    ReadMSWordFiles = arrResult
End With
Set FSO = Nothing
End Function

 

[sesongkhac]

Cảm ơn anh nhiều ạ. Đã chạy và lấy dữ liệu thành công.

 

[Ổ quạ]

Cảm ơn anh nhiều ạ. Đã chạy và lấy dữ liệu thành công.