Nhờ lấy dữ liệu từ nhiều file word để điền vào các sheet trong file excel

songtoan1994 · 6/10/20

Em chào các anh chị trong diễn đàn ạ!
Em muốn coppy các file word vào các sheet trong file excel
file 1 vào sheet 1, file 2 vào sheet 2, file 3 vào sheet 3 mà không cần mở file word được không ạ?
coppy hết tất cả nội word.
Mọi người có thể giúp em không ạ?
Em cảm ơn anh chị nhiều!

thnghiachau · 6/10/20

songtoan1994 đã viết:
Em chào các anh chị trong diễn đàn ạ!
Mọi người có thể giúp em

bạn bỏ quên file đính kèm ở đâu rồi?

songtoan1994 · 6/10/20

thnghiachau đã viết:
bạn bỏ quên file đính kèm ở đâu rồi?

mình có sửa lại bài viết rồi bạn! do mình viết chưa xong con mèo chạy qua nút Enter nên bài viết gửi đi luôn

bạn có thể xem lại bài viết dùm mình ạ!

thnghiachau · 6/10/20

songtoan1994 đã viết:
mình có sửa lại bài viết rồi bạn! do mình viết chưa xong con mèo chạy qua nút Enter nên bài viết gửi đi luôn bạn có thể xem lại bài viết dùm mình ạ!

Gỏi bạn code copy toàn bộ nội dung file RTF vào file Excel.

Mã:

Sub CopyFileRtfToExcel()
    Dim oWordApp As Object
    Set oWordApp = CreateObject("Word.Application")
    With oWordApp
        .Documents.Open Filename:="D:\Download\Output_1.rtf"
        .ActiveDocument.Select
        .Selection.Copy
    End With
    Sheet1.Range("A1").Select
    Sheet1.Paste
    oWordApp.Quit
    Set oWordApp = Nothing
End Sub

Bạn tùy biến để sử dụng nhá

songtoan1994 · 6/10/20

ai giúp mình với ạ!

songtoan1994 · 6/10/20

thnghiachau đã viết:
Gỏi bạn code copy toàn bộ nội dung file RTF vào file Excel.

Mã:

Sub CopyFileRtfToExcel() Dim oWordApp As Object Set oWordApp = CreateObject("Word.Application") With oWordApp .Documents.Open Filename:="D:\Download\Output_1.rtf" .ActiveDocument.Select .Selection.Copy End With Sheet1.Range("A1").Select Sheet1.Paste oWordApp.Quit Set oWordApp = Nothing End Sub

Bạn tùy biến để sử dụng nhá

nhưng bạn ơi theo code này thì mình chỉ mở đc file Output_1.rft trong thư mục nhất định thôi!
Có cách nào có thể select file word ấy ở trong 1 thư mục khác không? vì file word này không ở trong 1 thư mục cố định?
Mình thấy có code này tương tự, nhưng code này thì nó chỉ chọn thư mục chứ không cho chọn file! và chỉ coppy dòng thư 4 trong file word!



       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

thnghiachau · 6/10/20

songtoan1994 đã viết:
nhưng bạn ơi theo code này thì mình chỉ mở đc file Output_1.rft trong thư mục nhất định thôi!
Có cách nào có thể select file word ấy ở trong 1 thư mục khác không? vì file word này không ở trong 1 thư mục cố định?

Mình nói bạn là "tùy biến" rùi mà.
còn để chọn nhiều file bạn theo code này tùy biến ra cái bạn muốn nha.

Mã:

Dim vFile As Variant
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "File type", "*.rtf"
        .Title = "Choose one or more files RTF"
        If .Show <> 0 Then
            For Each vFile In .SelectedItems
                'Code copy All content file Rtf to Excel here
                '-----
                '-----
            Next vFile
            MsgBox "Finish", vbInformation, "---:: NOTICE ::---"
        Else
            MsgBox "Do NOTHING", vbCritical, "---:: Error ::---"
        End If
    End With

songtoan1994 · 6/10/20

thnghiachau đã viết:

Mình nói bạn là "tùy biến" rùi mà.
còn để chọn nhiều file bạn theo code này tùy biến ra cái bạn muốn nha.

Mã:

Dim vFile As Variant
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "File type", "*.rtf"
        .Title = "Choose one or more files RTF"
        If .Show <> 0 Then
            For Each vFile In .SelectedItems
                'Code copy All content file Rtf to Excel here
                '-----
                '-----
            Next vFile
            MsgBox "Finish", vbInformation, "---:: NOTICE ::---"
        Else
            MsgBox "Do NOTHING", vbCritical, "---:: Error ::---"
        End If
    End With

bạn có thể viết giúp mình nốt đc không ạ? mình có để cả file excel phía trên đó ạ! mình mới tìm hiểu VBA 2 ngày nên chưa hiểu hết câu lệnh trong này!
Mình ghép vào thì nó cho chọn file nhưng nó báo lỗi như này và không coppy được file word đó vào sheet 1!

thnghiachau · 6/10/20

songtoan1994 đã viết:
bạn có thể viết giúp mình nốt đc không ạ? mình có để cả file excel phía trên đó ạ! mình mới tìm hiểu VBA 2 ngày nên chưa hiểu hết câu lệnh trong này!
Mình ghép vào thì nó cho chọn file nhưng nó báo lỗi như này và không coppy được file word đó vào sheet 1!

bạn coi kỹ cái code copy bạn để ở đâu?????
Mình có ghi rất rõ:
'Code copy All content file Rtf to Excel here
Mỗi lần copy từ Word vào sheet nào trong workbook? bạn phải add sheet mới và copy vào sheet mới add vào đó!
mình đã viết hết cho bạn rùi, bạn chỉ việc ghép lại thôi theo cái mà bạn muốn.

songtoan1994 · 6/10/20

thnghiachau đã viết:
bạn coi kỹ cái code copy bạn để ở đâu?????
Mình có ghi rất rõ:
'Code copy All content file Rtf to Excel here
Mỗi lần copy vào sheet nào trong workbook? bạn phải add sheet vào và copy vào sheet mới add vào đó!
mình đã viết hết cho bạn rùi, bạn chỉ việc ghép lại thôi theo cái mà bạn muốn.

là sao ạ? mình phải coppy đoạn code nào để vào chỗ "Code coppy All content....." đó ạ! mình coppy đoạn code lúc đầu bạn gửi dán vào thì nó báo lỗi!

Bài đã được tự động gộp: 6/10/20

thnghiachau đã viết:
bạn coi kỹ cái code copy bạn để ở đâu?????
Mình có ghi rất rõ:
'Code copy All content file Rtf to Excel here
Mỗi lần copy vào sheet nào trong workbook? bạn phải add sheet vào và copy vào sheet mới add vào đó!
mình đã viết hết cho bạn rùi, bạn chỉ việc ghép lại thôi theo cái mà bạn muốn.

làm phiền bạn quá! nhưng thực sự mình không hiểu lấy cái nào dán vào chỗ nào ấy ạ!

thnghiachau · 6/10/20

songtoan1994 đã viết:
là sao ạ? mình phải coppy đoạn code nào để vào chỗ "Code coppy All content....." đó ạ! mình coppy đoạn code lúc đầu bạn gửi dán vào thì nó báo lỗi!

bạn coi ở bài #4 mình viết rất rõ: "Gỏi bạn code copy toàn bộ nội dung file RTF vào file Excel "
và bài #7 trong code mình cũng ghi rõ " Code copy All content file Rtf to Excel here "
và bài #9 mình ghi thêm " Mỗi lần copy từ word vào sheet nào trong workbook? bạn phải add sheet mới và copy vào sheet mới add vào đó! "
code add new sheet và dán cái nội dung word vào sheet mới add:

Mã:

                With Sheets.Add(After:=Sheets(Sheets.Count))
                    .Range("A1").Select
                    .Paste
                End With

songtoan1994 · 6/10/20

thnghiachau đã viết:
bạn coi ở bài #4 mình viết rất rõ: "Gỏi bạn code copy toàn bộ nội dung file RTF vào file Excel "
và bài #7 trong code mình cũng ghi rõ " Code copy All content file Rtf to Excel here "
và bài #9 mình ghi thêm " Mỗi lần copy từ word vào sheet nào trong workbook? bạn phải add sheet mới và copy vào sheet mới add vào đó! "
code add new sheet và dán cái nội dung word vào sheet mới add:

Mã:

With Sheets.Add(After:=Sheets(Sheets.Count)) .Range("A1").Select .Paste End With

Nghĩa là mình coppy code #4 dán vào chỗ " Code copy All content file Rtf to Excel here " của #7 ạ!
mình làm thế nhưng nhưng nó báo lỗi!

vanaccex · 6/10/20

songtoan1994 đã viết:
Nghĩa là mình coppy code #4 dán vào chỗ " Code copy All content file Rtf to Excel here " của #7 ạ!
mình làm thế nhưng nhưng nó báo lỗi!
View attachment 246854

Code bạn ấy viết thành từng đoạn mà, copy vậy chắc chắn lỗi rồi

songtoan1994 · 6/10/20

vanaccex đã viết:
Code bạn ấy viết thành từng đoạn mà, copy vậy chắc chắn lỗi rồi

vì mới mò mò VBA đc 2 ngày nên chưa hiểu gì cả!

thnghiachau · 6/10/20

songtoan1994 đã viết:
Nghĩa là mình coppy code #4 dán vào chỗ " Code copy All content file Rtf to Excel here " của #7 ạ!
mình làm thế nhưng nhưng nó báo lỗi!

Mình thua bạn luôn,
Mình nhìn cái file bạn gởi thấy code nhiều, mình nghĩ là bạn biết nên hướng dẫn cho bạn từng bước để bạn hiểu rõ hơn,
nhưng bạn làm ra cái như hình trên là mình botay với bạn!
Sao có cái Sub lồng trong cái sub kiều vậy được? phải phải xem mình copy cái gì vào chứ????
Cái file bạn gởi không của chính bạn Phải không?

Bài đã được tự động gộp: 6/10/20

songtoan1994 đã viết:
vì mới mò mò VBA đc 2 ngày nên chưa hiểu gì cả!

OK vậy bạn bê nguyên mâm cỗ này mà dùng...

Mã:

Option Explicit

Sub CopyFileRtfToExcel()
Dim wsNew As Worksheet
Dim vFile As Variant
Dim oWordApp As Object, oWordDoc As Object
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "File type", "*.rtf"
        .Title = "Choose one or more files RTF"
        If .Show <> 0 Then
            Set oWordApp = CreateObject("Word.Application")
            For Each vFile In .SelectedItems
                With oWordApp
                    Set oWordDoc = .Documents.Open(Filename:=vFile)
                    .ActiveDocument.Select
                    .Selection.Copy
                End With
                With Sheets.Add(After:=Sheets(Sheets.Count))
                    .Range("A1").Select
                    .Paste
                End With
                oWordDoc.Close
                Set oWordDoc = Nothing
            Next vFile
            oWordApp.Quit
            Set oWordApp = Nothing
            MsgBox "Finish", vbInformation, "---:: NOTICE ::---"
        Else
            MsgBox "Do NOTHING", vbCritical, "---:: Error ::---"
        End If
    End With
End Sub

songtoan1994 · 6/10/20

thnghiachau đã viết:
Mình thua bạn luôn,
Mình nhìn cái file bạn gởi thấy code nhiều, mình nghĩ là bạn biết nên hướng dẫn cho bạn từng bước để bạn hiểu rõ hơn,
nhưng bạn làm ra cái như hình trên là mình botay với bạn!
Sao có cái Sub lồng trong cái sub kiều vậy được? phải phải xem mình copy cái gì vào chứ????
Cái file bạn gởi không của chính bạn Phải không?

Bài đã được tự động gộp: 6/10/20

OK vậy bạn bê nguyên mâm cỗ này mà dùng...

Mã:

Option Explicit Sub CopyFileRtfToExcel() Dim wsNew As Worksheet Dim vFile As Variant Dim oWordApp As Object, oWordDoc As Object With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Filters.Clear .Filters.Add "File type", "*.rtf" .Title = "Choose one or more files RTF" If .Show <> 0 Then Set oWordApp = CreateObject("Word.Application") For Each vFile In .SelectedItems With oWordApp Set oWordDoc = .Documents.Open(Filename:=vFile) .ActiveDocument.Select .Selection.Copy End With With Sheets.Add(After:=Sheets(Sheets.Count)) .Range("A1").Select .Paste End With oWordDoc.Close Set oWordDoc = Nothing Next vFile oWordApp.Quit Set oWordApp = Nothing MsgBox "Finish", vbInformation, "---:: NOTICE ::---" Else MsgBox "Do NOTHING", vbCritical, "---:: Error ::---" End If End With End Sub

code này mình coppy trên mạng về với dùng recode macco, rồi thay đổi tý chứ mình chưa hiểu gì về nó đâu!

Maika8008 · 6/10/20

Khổ nhỉ! Mới sơ sinh mà phải ăn đồ cứng thì hại hệ tiêu hóa lắm --=0

songtoan1994 · 6/10/20

thnghiachau đã viết:
Mình thua bạn luôn,
Mình nhìn cái file bạn gởi thấy code nhiều, mình nghĩ là bạn biết nên hướng dẫn cho bạn từng bước để bạn hiểu rõ hơn,
nhưng bạn làm ra cái như hình trên là mình botay với bạn!
Sao có cái Sub lồng trong cái sub kiều vậy được? phải phải xem mình copy cái gì vào chứ????
Cái file bạn gởi không của chính bạn Phải không?

Bài đã được tự động gộp: 6/10/20

OK vậy bạn bê nguyên mâm cỗ này mà dùng...

Mã:

Option Explicit Sub CopyFileRtfToExcel() Dim wsNew As Worksheet Dim vFile As Variant Dim oWordApp As Object, oWordDoc As Object With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Filters.Clear .Filters.Add "File type", "*.rtf" .Title = "Choose one or more files RTF" If .Show <> 0 Then Set oWordApp = CreateObject("Word.Application") For Each vFile In .SelectedItems With oWordApp Set oWordDoc = .Documents.Open(Filename:=vFile) .ActiveDocument.Select .Selection.Copy End With With Sheets.Add(After:=Sheets(Sheets.Count)) .Range("A1").Select .Paste End With oWordDoc.Close Set oWordDoc = Nothing Next vFile oWordApp.Quit Set oWordApp = Nothing MsgBox "Finish", vbInformation, "---:: NOTICE ::---" Else MsgBox "Do NOTHING", vbCritical, "---:: Error ::---" End If End With End Sub

cảm ơn bạn nhiều nha! nhìn code hoàn thiện so với code cũ mình cũng hiểu ra vài điều!

chạy ngon rồi bạn ak!

thanks you!

Bài đã được tự động gộp: 6/10/20

Maika8008 đã viết:
Khổ nhỉ! Mới sơ sinh mà phải ăn đồ cứng thì hại hệ tiêu hóa lắm

còn chưa có răng để ăn ấy bạn!

Nhờ lấy dữ liệu từ nhiều file word để điền vào các sheet trong file excel

Thành viên mới

File đính kèm

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên mới

Thành viên tiêu biểu

Thành viên mới

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới