26/02/2022, 23:17
Excel Vba İle Word Belgesi Ve Yolunu Kaydetme
26/02/2022, 23:27
akaygisiz
Hocam word belgelerim ağda bulunuyor ve normal windows'un içerik arama olayına girdiğimde inanın çok ama çok uzun sürüyor. En kestirme bu yöntem gelmişti aklıma. Sizin kastettiğiniz Excel üzerinden bir arama mı acaba?
27/02/2022, 00:06
berduş
aklımda olan oydu, veri alınırken excele aktarmak yerine aranan verinin olup olmadığı kaydedilebilir.
denemedim teorik olarak olabilir diye düşünüyorum ama olur mu bilmem
denemedim teorik olarak olabilir diye düşünüyorum ama olur mu bilmem
27/02/2022, 00:42
berduş
kodları aşağıdaki gibi düzenleyip dener misiniz
harf sınırı 30 bin yaptım
iyice deneyin
çok kontrol edemedim
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
27/02/2022, 19:41
akaygisiz
Denedim 30.000 karakterden sonra alt satıra devam ediyor hocam teşekkür ederim.