kodları aşağıdaki gibi düzenleyip dener misiniz

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, 2) = xFilePath

   For HrfSay = 1 To Len(data & "") Step 30000

        Sayfa1.Cells(xSatir, 1) = Mid(xStr, HrfSay, 30000)

        xSatir = xSatir + 1

   Next HrfSay

   'close the document

   x.Close

   Set x = Nothing



End Sub

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 = .SelectedItems.Count

    For Each xWord In .SelectedItems

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

       Word2Text xWord, i

    Next xWord

End If

End With

Application.ScreenUpdating = True

'Debug.Print "Normal Aktarım Tamam! " & vbNewLine & "Süre : " & Timer - t1 & " saniye " & vbNewLine & "Aktarılan Dosya sayısı : " & DsSay

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

End Sub

---

harf sınırı 30 bin yaptım
iyice deneyin
çok kontrol edemedim