Mừng Sinh Nhật GPE 11: sáng 25/6 Hà Nội; 1/7 Huế/Đà Nẵng; Trưa 2/7 TPHCM

Làm sao để lấy dữ liệu từ file word từ hyperlink trong Excel

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi tdmuoi, 8 Tháng mười một 2008.

  1. tdmuoi

    tdmuoi Thành viên mới

    Chào các bạn,

    Tôi có 1 số file word chứa CV của các ứng viên, muốn tạo 1 file excell và hàm để có thể đọc nội dung file và tìm kiếm để lấy ra Họ và tên, Ngày sinh, Mobile email hay những thông tin khác trong các file word này!
    Tôi có đính kèm các file word và file Excell chứa các link đến các file word,

    Nhờ các bạn chỉ giúp !
     

    Các file đính kèm:

  2. longlt08

    longlt08 Thành viên thường trực

    Chào bạn ! Mình hiểu ý bạn là muốn tạo một hypelink từ excel đến các file Word để lấy các dữ liệu về excel để sắp xếp và sử dụng (trong excel) đúng không ?
    Nếu như vây theo mình khó thực hiện được vì phải mã hoá, viết lệnh VBA rất tốn kém thời gian. Thông thường găp các file word như vây người ta copy, dồn dữ liệu trong word thành một bảng rồi copy về excel. Cách này đơn giản hơn, chỉ mất công tý chút mà không phải dùng "nội công VBA thâm hậu".
     
  3. levanduyet

    levanduyet Thành viên danh dự

    To: tdmuoi,

    1. Để lấy dữ liệu từ Ms Word sang Excel bạn phải đưa dữ liệu vào các trường như trong ví dụ sau:
    http://www.tinhoc365.com/MSWord/TaoformnhaplieutrongMSWord.html

    2. Sau đó đọc bài tham khảo tại đây:
    http://www.sfdp.net/home-88.html

    3. Và tải ví dụ về tại đây:
    http://www.sfdp.net/my_softwares/word_miscelaneous/index.html
    Ở trên là các bước để viết một công cụ đáp ứng yêu cầu của bạn.

    Lê Văn Duyệt
     
  4. levanduyet

    levanduyet Thành viên danh dự

    Code mẫu từ CollectData.xls

    Sau đây là code trong tập tin CollectData.xls tôi xin mạn phép tác giả đưa lên đây để phân tích.
    Code sau được đặt trong Thisworkbook

    Mã:
    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
    
    Các bạn chỉ cần quan tâm đoạn code mà tôi tô màu xanh.
    Các bước thực hiện:
    _ Tìm tập tin *.doc
    Mã:
    With Application.FileSearch
            .Filename = "*.doc"
    Trong cùng thư mục của tập tin Excel của chúng ta
    Mã:
    .LookIn = ThisWorkbook.Path
    Sau đó nếu tìm thấy thì thì chúng ta sẽ gọi một thủ tục WriteCell để đưa dữ liệu ra tập tin Excel.

    Trong thủ tục WriteCell đoạn code quan trọng là:
    Mã:
        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
    
    Thủ tục sẽ quét qua các trường trong tài liệu word tìm thấy để điền vào các ô trong Excel.
    Mã:
    With wrdDocs
                 For i = 1 To .FormFields.Count
    
                 Next 
            End With
    
    Như vậy nếu các bạn thiết kế tập tin Word hợp lý (với các trường dữ liệu), thì bạn hoàn toàn có thể lấy dữ liệu nếu bạn cần từ Word để đưa qua Excel.

    Lê Văn Duyệt
     
    Lần chỉnh sửa cuối: 8 Tháng mười một 2008
  5. levanduyet

    levanduyet Thành viên danh dự

    Các bạn chú ý:
    Mã:
    [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]
    
    Đoạn mã ở trên chỉ dùng cho Excel 2003, nếu các bạn dùng cho Excel 2007 thì các bạn sẽ nhận được thông báo lỗi vì trong Excel 2007 không hổ trợ Application.FileSearch

    Vậy các bạn có thể thay thế đoạn code ở trên bằng đoạn code sau:
    Mã:
    Dim sFil As String
        Dim sPath As String
    
        sPath = ThisWorkbook.Path    'Lấy thư mục của tập tin Excel
        ChDir sPath
        sFil = Dir("*.doc")    'Định dạng tập tin chúng ta cần
        Do While sFil <> ""   
            Set wrdDoc = wrdApp.Documents.Open(Filename:=sPath & "\" & sFil, ReadOnly:=True)    'Mở tập tin
            WriteCell wrdDoc    ' Gọi thủ tục để lấy thông tin
            ' close the document
            wrdDoc.Close
            sFil = Dir
        Loop  
    
    Lê Văn Duyệt
     

Chia sẻ trang này