Sub WordAd()

t1 = Timer

Application.ScreenUpdating = False

Set sht = ThisWorkbook.Worksheets("WordXL")

      i = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1

Dim fDialog As FileDialog

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

    .AllowMultiSelect = True

    .Title = "Word belgelerini seçiniz"

    .InitialFileName = ThisWorkbook.Path

    'Optional: Add filters

    .Filters.Clear

    .Filters.Add "Word Belgeleri", "*.doc,*.docx"

    .Filters.Add "Tüm Dosyalar", "*.*"



If .Show = -1 Then

DsSay = 0

    For Each xWord In .SelectedItems

      Word2Text xWord, i

      i = i + 1

      DsSay = DsSay + 1

    Next xWord

End If

End With

Application.ScreenUpdating = True

  MsgBox "Aktarım Tamam! " & vbNewLine & "Süre : " & (Timer - t1) & " saniye " & vbNewLine & "Aktarılan Dosya sayısı : " & DsSay

End Sub

Public Sub Word2Text(ByVal xFilePath As String, ByVal xSatir As Long)  'Word2Text "d:\Desktop\Word2Excel\19 - Vba Class Modules.docx"



  Dim x As Document

  Set x = Documents.Open(xFilePath, ReadOnly:=True, Visible:=False)

  Dim data

  Set data = x.Content

  ' do something with the content or the document

  xStr = data

  Sayfa1.Cells(xSatir, 1) = xStr

  Sayfa1.Cells(xSatir, 2) = xFilePath

  'close the document

  x.Close

  Set x = Nothing



End Sub