Can only process 50 WORD documents at a time

[bobk544]

Hello,

I'm wondering if there is a command to release the memory that WORD is
apparently loading when processing many WORD documents?

pgmlinkloop is calling Scriptlink and is apparently loading each WORD
document into memory becasue after processing 50 or so documents the
HYPERLINKS come out scrambled.

And even though i have these statements in Scriptlink:

ActiveDocument.Save '(wdSaveChanges)
ActiveDocument.Close

it must not be releasing the memory?

So because of this limitation, i have to process 50 DOCS at a time and then
it works fine, ie the HYPERLINKS come out ok versus "Error with
HYPERLINK........."

Thanks very much for any ideas!
BobK


pgmlinkloop()
.............
'For i = 0 To 49
'For i = 50 To 99
'For i = 79 To 99
For i = 100 To 149
'For i = 150 To 199
'For i = 200 To 249
'For i = 250 To 299
'For i = 300 To 349
'For i = 350 To 399
'For i = 400 To 420

f = FileArray(i)

Call ScriptLink(f)

End Sub



Sub ScriptLink(file As String)

............

ActiveDocument.Save '(wdSaveChanges)
ActiveDocument.Close

End Sub


Complete code:
=====================================================

Sub pgmlinkloop()
Dim FileArray() As String, ffile As String, Count As Integer
Count = 0

With Dialogs(wdDialogFileOpen)
.Name = "*.*"
.Show
End With

ffile = Dir("*")

'ffile = Dir("c:\RBC_XPGMS\*")

'MsgBox ("ffile1" + ffile)

ReDim FileArray(Count) ' 0 based array -- dimensioning for 1 entry in the
array
FileArray(Count) = LCase(ffile)
Count = 1
Do While ffile <> ""
ffile = Dir()
'MsgBox ("ffile2" + ffile)
If ffile <> "." And ffile <> ". ." Then
ReDim Preserve FileArray(Count) ' Resizing array dynamically
FileArray(Count) = LCase(ffile)
Count = Count + 1
End If
Loop

Dim lb As Integer
Dim ub As Integer
lb = LBound(FileArray(), 1)
ub = UBound(FileArray(), 1)
ub = ub - 1

Dim f As String

'For i = 0 To 49
'For i = 50 To 99
'For i = 79 To 99
For i = 100 To 149
'For i = 150 To 199
'For i = 200 To 249
'For i = 250 To 299
'For i = 300 To 349
'For i = 350 To 399
'For i = 400 To 420
'For i = 145 To 155

f = FileArray(i)

'pgmlink (f)

Call ScriptLink(f)

'singlelinks (f)

Next

End Sub



Sub ScriptLink(file As String)

Documents.Open (file)

'These hold the range of the words we are looking at
Dim aword As Range 'The current word range
Dim pword As Range 'The previous word range
Dim sw As String 'Raw word pulled from doc
Dim Excludes As String 'Words to be excluded
Dim SingleWord As String

Dim bm As String
Dim naddr As String
Dim xref As String
Dim rdir As String
Dim line As String
Dim impflag As String
Dim bs1 As Integer
Dim es1 As Integer
Dim bs2 As Integer
Dim es2 As Integer

Dim la(100) As String

Dim ar(10) As String
Dim i As Integer
ar(9) = ""
ar(8) = ""
ar(7) = ""
ar(6) = ""
ar(5) = ""
ar(4) = ""
ar(3) = ""
ar(2) = ""
ar(1) = ""
ar(0) = ""

Set pword = Nothing

For Each aword In ActiveDocument.Words

sw = Trim(LCase(aword))

If sw <> vbCr And sw <> vbLf And sw <> vbCrLf And sw <> ">" And sw
<> "<" Then
ar(9) = ar(8)
ar(8) = ar(7)
ar(7) = ar(6)
ar(6) = ar(5)
ar(5) = ar(4)
ar(4) = ar(3)
ar(3) = ar(2)
ar(2) = ar(1)
ar(1) = ar(0)
ar(0) = sw
End If

If ar(1) = "@" And ar(0) = "b" Then
xref = "y"
End If

If xref = "y" Then

'MsgBox ("1:" + sw)

Dim ls As Long
ls = Len(sw)

Dim pc As Integer
pc = InStr(1, sw, "-", Compare)
If pc = 0 Then
pc = InStr(1, sw, "+", Compare)
End If

bs1 = 0
es1 = pc
bs2 = es1 + 1
es2 = ls

Dim s1 As String
s1 = " "
Dim d1 As Integer
d1 = es1 - bs1 - 1

If pc <> 0 Then

'MsgBox ("2:" + ar(1) + " pc: " + CStr(pc))

s1 = Mid$(ar(1), 1, d1)

ls = Len(s1)

If ls = 1 Then
s1 = "00" + s1
End If

If ls = 2 Then
s1 = "0" + s1
End If

'rdir = "c:\_XREF_PGMS\n" + s1 + "*"

'MsgBox ("2." + rdir)
'sdir = Dir(rdir)
'sdir = "c:\_XREF_SINGLE\PROCESS\" '+ sdir

'MsgBox ("3." + aword + " " + sdir)

s1 = Mid$(sw, pc + 1, es2)

'MsgBox (s1)

s1 = ar(1)

Dim sa As String
sa = "b" + s1

'MsgBox ("4." + sa)

With ActiveDocument.Hyperlinks
.Add Anchor:=pword, _
Address:=sdir, SubAddress:=sa
End With

End If

End If

If ar(1) = "@" And ar(0) = "e" Then
xref = "n"
End If

If sw <> vbCr And sw <> vbLf And sw <> vbCrLf Then
Set pword = aword
End If

If sw = vbCr Or sw = vbLf Or sw = vbCrLf Then
impflag = "n"
End If

Next aword


Set aword = Nothing
Set pword = Nothing

ActiveDocument.Save '(wdSaveChanges)
ActiveDocument.Close

End Sub