Option Explicit
Dim DefaultProgressLength As Long
Sub GetInfor()
' Khoi tao cac bien ket noi DDE voi WORD
Dim wrdApp As Object
Dim wrdDoc As Object
Dim i As Long
' Tao doi tuong Word
Set wrdApp = CreateObject("Word.Application")
'Giau man hinh Word
wrdApp.Visible = False
' Tim tat ca cac tap tin Doc trong thu muc chua van ban da thu thap ve
Dim iObj As Object
' Show the progress bar
Sheet1.lbFrame.Visible = True
Sheet1.lbProgress.Visible = True
[COLOR="Blue"]With Application.FileSearch
.Filename = "*.doc"
.LookIn = ThisWorkbook.Path
.Execute
For i = 1 To .FoundFiles.Count
Set wrdDoc = wrdApp.Documents.Open(Filename:=.FoundFiles(i), ReadOnly:=True)
' Cac ban co the dat mot truong an dac biet de kiem tra
' xem tai lieu co dung la tai lieu minh can khong .....
' advancing the progress...
Sheet1.lbProgress.Width = DefaultProgressLength * (i / .FoundFiles.Count)
Sheet1.lbProgress.Caption = 100 * i / .FoundFiles.Count & "% Finished"
Application.StatusBar = "Processing, " & i & "/" & .FoundFiles.Count & " documents imported!"
WriteCell wrdDoc ' Goi thu tuc de lay thong tin
' close the document
wrdDoc.Close
Next i
End With[/COLOR]
Set wrdDoc = Nothing
wrdApp.Quit
' Hide the progress bar
Sheet1.lbFrame.Visible = False
Sheet1.lbProgress.Visible = False
' set the status to on
Application.StatusBar = "Finished processing, " & i - 1 & " documents imported!"
End Sub
Sub [COLOR="Blue"][B]WriteCell[/B][/COLOR](wrdDocs As Object)
Dim i As Long, RowtoStart As Long
Dim xlSheet As Worksheet
Set xlSheet = Sheet1
' First open and determine the row to start
' This is for append the data / to current sheet
' You can also put code here to verify wherether data is duplicated or not
i = 2
While Val(xlSheet.Cells(i, 1).Value) <> 0
i = i + 1
Wend
RowtoStart = i - 1
' Order colunm
If RowtoStart <> 1 Then
xlSheet.Cells(RowtoStart + 1, 1).Value = RowtoStart
Else
xlSheet.Cells(RowtoStart, 1).Value = "Order"
xlSheet.Cells(RowtoStart + 1, 1).Value = RowtoStart
End If
With wrdDocs
For i = 1 To .FormFields.Count
' First Create a header row
If RowtoStart = 1 Then
xlSheet.Cells(RowtoStart, i + 1).Value = .FormFields(i).Name
End If
' details
xlSheet.Cells(RowtoStart + 1, i + 1).Value = .FormFields(i).Result
Next
End With
Set xlSheet = Nothing
End Sub
Private Sub Workbook_Open()
' hide the progressbar as default
Sheet1.lbFrame.Visible = False
Sheet1.lbProgress.Visible = False
' remember the length of the progress bar
DefaultProgressLength = Sheet1.lbProgress.Width
Sheet1.lbProgress.Width = 0
End Sub
