Copy text from word to excel - "Out of disk space" error

[dzogchen]

Hi evereryone,

With the follwing procedure which intends to retrieve specific text (red square in the above image) from word documents:
29915



Sub Abrir()


Dim FolderName As String
Dim FileName As String
Dim NewDoc As Object
Dim NewWordFile As Object


Dim A As String
Dim r As Integer




Range("A2:B1000").Value = ""
Range("A2").Select


r = 2


FolderName = "C:\Users\njesus\Documents\Os meus documentos\"
FileName = Dir(FolderName & "*.doc*")




Do While FileName <> ""


On Error Resume Next
Set NewDoc = CreateObject("word.application")
NewDoc.Application.Visible = False
Set NewDoc = GetObject(FolderName & FileName)


A = NewDoc.Range(12, 25)
Range("A" & r).Value = A

A = NewDoc.Range(200, 500)
Range("B" & r).Value = A

r = r + 1

NewDoc.Close SaveChanges:=wdDoNotSaveChanges
NewWordFile.Quit

FileName = Dir()


Set NewDoc = Nothing
Set NewWordFile = Nothing


Loop


End Sub


works for folders with a few word documents, but for folders with more than 100 documents it is creating huge amount of data and I keep run out of disk space. Can anyone help me understanding why is this happening?

Thank you!

Regards

[georgiboy]

You could try it like the below, there were too many bits inside the loop:

Sub Abrir()
Dim FolderName As String
Dim FileName As String
Dim wdApp As Object
Dim NewDoc As Object

Range("A2:B" & Rows.Count).ClearContents

FolderName = "C:\Users\njesus\Documents\Os meus documentos\"
FileName = Dir(FolderName & "*.doc*")
Set wdApp = CreateObject("word.application")
wdApp.Application.Visible = False

Do While FileName <> ""
Set NewDoc = GetObject(FolderName & FileName)
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(, 2).Value = Array(NewDoc.Range(12, 25), NewDoc.Range(200, 500))
NewDoc.Close SaveChanges:=False
FileName = Dir()
Loop

wdApp.Quit
End Sub

[snb]

Keep it simple.
Avoid 'On error Resume Next'


Sub M_snb()
c00="C:\Users\njesus\Documents\Os meus documentos\"
c01= Dir(c00 & "*.doc*")

do while c01<>""
with getobject(c00 & c01)
c02=c02 & vblf & .paragraphs(7).range.text
.close 0
end with
c01=Dir
loop

Msgbox c02
End Sub

[macropod]

Undoubtedly, creating multiple Word instances that you don't kill has choked your system(Hint: NewWordFile.Quit does not relate to Set NewDoc = CreateObject("word.application")). Your code has other issues, too.

Here's a more flexible approach that allows for the possibility that doesn't require knowing in advance which paragraphs contain your strings or, especially for the second string, how long it might be:

Sub Abrir()
Dim StrFldr As String, StrFlNm As Strin, WdObj As Object, WdDoc As Object, xlSht As Worksheet, r As Long
StrFldr = "C:\Users\njesus\Documents\Os meus documentos\": r = 1
Set WdObj = CreateObject("Word.Application"): WdObj.Visible = False
Set xlSht = ActiveSheet: xlSht.Range("A2:B" & Rows.Count).ClearContents
StrFlNm = Dir(StrFldr & "*.doc*")
Do While StrFlNm <> ""
r = r + 1
Set WdDoc = WdObj.Documents.Open(StrFldr & StrFlNm)
With WdDoc
With .Range
With .Find
.MatchWildcards = True
.Text = "N/O Ref[!\:]@:[!/]@/[! ]@>"
.Execute
End With
If .Find.Found Then xlSht.Range("A" & r).Value = Split(.Text, ":")(1)
End With
With .Range
With .Find
.MatchWildcards = True
.Text = "ASSUNTO:[!^13]@^13"
.Execute
End With
If .Find.Found Then xlSht.Range("B" & r).Value = Split(.Text, "ASSUNTO:")(1)
End With
.Close False
End With
StrFlNm = Dir()
Loop
Set WdDoc = Nothing: Set WdObj = Nothing: Set xlSht = Nothing
End Sub

[dzogchen]

Hi,

Thank you all for your reply!


Undoubtedly, creating multiple Word instances that you don't kill has choked your system(Hint: NewWordFile.Quit does not relate to Set NewDoc = CreateObject("word.application")). Your code has other issues, too.

True! In the meanwhile i remember to opened the windows task bar and saw a bunch of word documents tasks opened, it was that what was filling my disk, so I changed the "CreateObject("word.application")" to "GetObject("word.application")" and it worked, but since the code is not optimized it takes around 1h to do 150 documents....

macropod :bow: it was that code that I was looking for, it works like a charm! thank you very much!!! :bow: