Hi Dick,
I can post the code unfortunately it is rather big. I am doing alot of
manipulation with it. There are other sub procedures that I did not include
I only included the relevant ones. If someone can help me spot the problem
that would be great. It appears that the mail merge sub procedure which I am
also doing and will include seems to bomb and gives an error stating file in
use personal.xls is locked for editing however this is just another macro
that I have stored and doesn't apply to this macro at all. Thanks for the
help. I will try to go through it step by step to see why it seems to be
locking the workbooks for editing. I just wish I could open them without
this.
Thanks
Heather

CODE:
Public AppXL As Object
Dim XLBook As Object
Dim XLBook2 As Object
Dim XLBook3 As Object
Dim XLBookENG As Object
Dim XLBookFRE As Object
Dim XLSheet As Object
Dim XLSheet1 As Object
Dim XLSheet2 As Object
Dim XLShtEng As Object
Dim XLShtFre As Object

Dim XLrng As Object
Dim XLrng1 As Object
Private Const xlUP As Long = -4162
Dim lislrow As Long




'varfname is a file and location entered in a userform text box and passed
to procedure (ie. "C:\Model Pilot\3456789.xls")
Sub client_count(varfname)
' Macro A
'open excel client listing table and count number of accounts.


Dim xlntrn As Boolean
Dim lokval As Integer
Dim clcnt As Integer
Dim cnttxt As String
Dim thisWB As Object


On Error Resume Next
Set AppXL = CreateObject("Excel.application")

If Err Then
xlntrn = True
Set AppXL = New Application
End If

clcnt = 0


Set XLBook1 = AppXL.workbooks.Open(filename:="C:\Model Pilot\ Model
GridI.xls", Password:="Cookie")
Set XLBook2 = AppXL.workbooks.Open(filename:="C:\Model Pilot\Names.xls",
Password:="Cookie")
Set XLBook = AppXL.workbooks.Open(filename:=varfname)
Set XLBookENG = AppXL.workbooks.Open(filename:="C:\Model Pilot\EngMrg.xls")
Set XLBookFRE = AppXL.workbooks.Open(filename:="C:\Model Pilot\FreMrg.xls")


Set XLSheet = XLBook.worksheets(1)
Set XLSheet1 = XLBook1.worksheets(1)
Set XLSheet2 = XLBook2.worksheets(1)
Set XLShtEng = XLBookENG.worksheets(1)
Set XLShtFre = XLBookFRE.worksheets(1)

XLSheet1.Activate
Set XLrng = XLSheet1.Range("A2:M55")
XLSheet2.Activate
Set XLrng1 = XLSheet2.Range("A2:E36")


XLSheet.Activate
lislrow = XLSheet.Range("A65536").End(xlUP).Row

'sort data by lastname account number in listing excel file
'Range("A2:Y" & lislrow).Sort Key1:=Range("G2"), Order1:=xlAscending,
Key2:=Range _
("A2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal

For counter = 2 To lislrow

If counter 2 Then
If XLSheet.Cells(counter, 1).Value = XLSheet.Cells(counter - 1,
1).Value Then
GoTo Label1
End If
End If

If XLSheet.Cells(counter, 26).Value = "Y" Then
GoTo Label1
End If
If XLSheet.Cells(counter, 26).Value = "y" Then
GoTo Label1
End If

clcnt = clcnt + 1#


Label1:
Next counter


cnttxt = "There are " & clcnt & " client accounts listed."
UserForm2.txtbox_cnt = cnttxt
UserForm1.Hide
UserForm2.Show
End Sub


Sub switch_form(varfname)
' Macro created 2/26/2005 by Heather Ouellette
'
'open excel and workbooks to do lookups and store in listing table.


Dim lokval As Integer
Dim lokval2 As String
Dim dtdwnld As String
Dim tovar As String
Dim fromvar As String
Dim acctno As String
Dim xrefno As String
Dim grpno As String
Dim Dlrno As String
Dim repno As String
Dim colx As String
Dim coly As String
Dim fname As String
Dim finadv As String
Dim colT As String
Dim tbl1dat, col1, col2, col3, col4, col5, col6, col7, col8
Dim tbl2dat, colA, colB, colC, colD
Dim fundnam1 As String
Dim fundno1 As String
Dim unitno As String
Dim mv As String
Dim pacamt As String
Dim swpamt As String
Dim fundnam2 As String
Dim fundnoA As String
Dim fundnoB As String
Dim lang As String
Dim trow As Integer
Dim fstcpy As String
Dim dtyr As String
Dim dtmm As String
Dim dtdy As String
Dim frstnam As String
Dim lstnam As String
Dim midpt As Integer
Dim firstnm As String
Dim midnm As String
Dim lastnm As String
Dim rwadd As String
Dim numrws As Long
Dim fndint As String
Dim grsnet As String
Dim prevlng As String
'colx, coly variables
Dim BkMrkToUpdte As String
Dim TxtToUse As String
'mail merge variables
Dim eshtcnt As Long
Dim fshtcnt As Long
Dim AstMdl As String
'sort data by lastname account number in listing excel file
' Range("A2:Y" & lislrow).Sort Key1:=Range("G2"), Order1:=xlAscending,
Key2:=Range _
("A2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal

For counter = 2 To lislrow
If counter = 2 Then
eshtcnt = 1
fshtcnt = 1
End If
'skip rows where col Z contains a "Y,y" -suppress records
If XLSheet.Cells(counter, 26).Value = "Y" Then
GoTo Label1
End If
If XLSheet.Cells(counter, 26).Value = "y" Then
GoTo Label1
End If

'lookup value
lokval = XLSheet.Cells(counter, 15).Value


'row AE - col L of Model Grid
res = AppXL.vlookup(lokval, XLrng, 12, False)
If IsError(res) Then
XLSheet.Cells(counter, 31).Value = ""
Else:
XLSheet.Cells(counter, 31).Value = res
End If


'row AF - col H of Model Grid
res = AppXL.vlookup(lokval, XLrng, 8, False)
If IsError(res) Then
XLSheet.Cells(counter, 32).Value = ""
Else:
XLSheet.Cells(counter, 32).Value = res
End If

'row AB - used for AC lookup
res = AppXL.vlookup(lokval, XLrng, 2, False)
If IsError(res) Then
XLSheet.Cells(counter, 28).Value = ""
Else:
XLSheet.Cells(counter, 28).Value = res
End If

'row AD - Fund Name for Buy (from Model..xls)
If XLSheet.Cells(counter, 14).Value = "E" Then 'English name
res = AppXL.vlookup(lokval, XLrng, 10, False)
If IsError(res) Then
XLSheet.Cells(counter, 30).Value = ""
Else:
XLSheet.Cells(counter, 30).Value = res
End If
Else:
res = AppXL.vlookup(lokval, XLrng, 11, False) 'French name
If IsError(res) Then
XLSheet.Cells(counter, 30).Value = ""
Else:
XLSheet.Cells(counter, 30).Value = res
End If
End If

'row AC - Fund Name for Sell (from Names.xls)

lokval2 = XLSheet.Cells(counter, 28).Value
If XLSheet.Cells(counter, 14).Value = "E" Then 'English name
res = AppXL.vlookup(lokval2, XLrng1, 3, False)
If IsError(res) Then
XLSheet.Cells(counter, 29).Value = ""
Else:
XLSheet.Cells(counter, 29).Value = res
End If
Else:
res = AppXL.vlookup(lokval2, XLrng1, 5, False) 'French Name
If IsError(res) Then
XLSheet.Cells(counter, 29).Value = ""
Else:
XLSheet.Cells(counter, 29).Value = res
End If
End If


'build merge files for mail merge
If counter = 2 Then
Call bld_ml_mrg(eshtcnt, fshtcnt, AstMdl, counter)
End If
If counter 2 Then
If XLSheet.Cells(counter, 1).Value < XLSheet.Cells(counter - 1,
1).Value Then
Call bld_ml_mrg(eshtcnt, fshtcnt, AstMdl, counter)
End If
'if same account number check if different model values and
assign appropriate text for mail merge document since may have both models.
If XLSheet.Cells(counter, 1).Value = XLSheet.Cells(counter - 1,
1).Value Then
If XLSheet.Cells(counter, 14).Value = "E" Then
Select Case AstMdl
Case "Blue and Green Models"
GoTo labelX

Case "Blue Models"
If Mid(XLSheet.Cells(counter, 16).Value, 1, 8) < "BL"
Then
AstMdl = "Blue and Green Models"
XLShtEng.Cells(eshtcnt, 9).Value = AstMdl
End If

Case "Green Models"
If Mid(XLSheet.Cells(counter, 16).Value, 1, 8) = "GR"
Then
AstMdl = "Blue and Green Models"
XLShtEng.Cells(eshtcnt, 9).Value = AstMdl
End If
End Select
End If
If XLSheet.Cells(counter, 14).Value < "E" Then
Select Case AstMdl
Case "modèles Blue"
GoTo labelX

Case "modèles Blue"
If Mid(XLSheet.Cells(counter, 16).Value, 1, 8) < "BL"
Then
AstMdl = "modèles Blue et Verte"
XLShtFre.Cells(fshtcnt, 9).Value = AstMdl
End If

Case "modèles Green"
If Mid(XLSheet.Cells(counter, 16).Value, 1, 8) = "GR"
Then
AstMdl = "modèles Blue et Verte"
XLShtFre.Cells(fshtcnt, 9).Value = AstMdl
End If
End Select
End If
labelX:
End If
End If


Label1:
Next counter




'read through the excel file and get data
fstcpy = "NO"
rwadd = "NO"
For counter = 2 To lislrow

If counter = 2 Then
Call opn_docs
End If

'ignore rows where col Z has a "Y"
If XLSheet.Cells(counter, 26).Value = "Y" Then
GoTo Label2
End If
If XLSheet.Cells(counter, 26).Value = "y" Then
GoTo Label2
End If


lang = XLSheet.Cells(counter, 14).Value


If XLSheet.Cells(counter, 14).Value = "E" Then
lang = "Eng"
Else
lang = "Fre"
End If ' counter, 14 = E
'set active document to lang
If counter = 2 Then
Call src_doc(lang)
End If

colx = "NO"
coly = "NO"

' copy document

If counter 2 Then
If XLSheet.Cells(counter, 1).Value < XLSheet.Cells(counter - 1,
1).Value Then
'determine if it's first time to copy documents
If fstcpy = "YES" Then
fstcpy = "DONE"
End If
If fstcpy = "NO" Then
fstcpy = "YES"
End If


'copy to output append on other stuff

Call copy_doc(fstcpy)
Call src_doc(lang)

Call clr_tbl_data(rwadd, numrws)
Call clr_colxy(lang)
End If 'account not equal to previous account
End If

' TABLE values
If counter 2 Then

' check if same account
If XLSheet.Cells(counter, 1).Value = XLSheet.Cells(counter - 1,
1).Value Then
' same account update table data
If XLSheet.Cells(counter, 17).Value 0 Then
fundnam1 = XLSheet.Cells(counter, 29).Value
fundno1 = XLSheet.Cells(counter, 15).Value
unitno = XLSheet.Cells(counter, 17).Value
mv = "$" & Round(XLSheet.Cells(counter, 19).Value, 2)

If XLSheet.Cells(counter, 24).Value 0 Then
pacamt = XLSheet.Cells(counter, 24).Value
Else
pacamt = ""
End If
If XLSheet.Cells(counter, 25).Value 0 Then
swpamt = XLSheet.Cells(counter, 25).Value
Else
swpamt = ""
End If
fundnam2 = XLSheet.Cells(counter, 30).Value
fundnoA = XLSheet.Cells(counter, 31).Value
fundnoB = XLSheet.Cells(counter, 32).Value

If lang = "Eng" Then
grsnet = "ALL"
Else
grsnet = "TOUT"
End If

trow = trow + 1
tbl1dat = Array(trow, fundnam1, fundno1, unitno, mv,
grsnet, pacamt, swpamt)
tbl2dat = Array(trow, fundnam2, fundnoA, fundnoB)
Call tbl_data(tbl1dat, tbl2dat, rwadd, numrws)
GoTo Label2
End If
End If
End If 'counter greater then 2


'BOOKMARKED DATA for INSRT

If XLSheet.Cells(counter, 24).Value 0 Then
colx = "YES"
Else
colx = "NO"
End If

If XLSheet.Cells(counter, 25).Value 0 Then
coly = "YES"
Else
coly = "NO"
End If


acctno = XLSheet.Cells(counter, 1).Value
xrefno = XLSheet.Cells(counter, 2).Value

If XLSheet.Cells(counter, 5).Value = 0 Then
grpno = " "
Else
grpno = XLSheet.Cells(counter, 5).Value
End If

Dlrno = XLSheet.Cells(counter, 3).Value
repno = XLSheet.Cells(counter, 4).Value


'convert to title case
'firstnm = XLSheet.Cells(counter, 6).Value
'lastnm = XLSheet.Cells(counter, 7).Value

'First Name
Call title_case(XLSheet.Cells(counter, 6).Value, firstnm)

For k = 1 To Len(firstnm)

If Mid(firstnm, k, 1) = " " Then
midpt = k
Call title_case(Mid(firstnm, 1, k - 1), frstnam)
Call title_case(Mid(firstnm, k + 1, Len(firstnm)), midnm)
firstnm = frstnam & " " & midnm
End If
Next k

'Last Name
Call title_case(XLSheet.Cells(counter, 7).Value, lstnam)
For m = 1 To Len(lstnam)
If Mid(lstnam, m, 1) = " " Then
midpt = m
Call title_case(Mid(lstnam, 1, k - 1), lastnm)
Call title_case(Mid(lstnam, k + 1, Len(lstnam)), midnm)
firstnm = lastnm & midnm
End If
Next m

fname = firstnm & " " & lstnam
fromvar = firstnm & " " & lstnam



dtdwnld = XLSheet.Cells(counter, 27).Value
Call cnvrt_date(dtdwnld)

Call insrt_data(dtdwnld, tovar, fromvar, acctno, xrefno, grpno,
Dlrno, repno, colx, coly, fname, finadv, colT, lang)

'assign table values
If XLSheet.Cells(counter, 17).Value 0 Then
fundnam1 = XLSheet.Cells(counter, 29).Value
fundno1 = XLSheet.Cells(counter, 15).Value
unitno = XLSheet.Cells(counter, 17).Value
mv = "$" & Round(XLSheet.Cells(counter, 19).Value, 2)

If XLSheet.Cells(counter, 24).Value 0 Then
pacamt = XLSheet.Cells(counter, 24).Value
Else
pacamt = ""
End If

If XLSheet.Cells(counter, 25).Value 0 Then
swpamt = XLSheet.Cells(counter, 25).Value
Else
swpamt = " "
End If

fundnam2 = XLSheet.Cells(counter, 30).Value
fundnoA = XLSheet.Cells(counter, 31).Value
fundnoB = XLSheet.Cells(counter, 32).Value
trow = 1
If lang = "Eng" Then
grsnet = "ALL"
Else
grsnet = "TOUT"
End If
tbl1dat = Array(trow, fundnam1, fundno1, unitno, mv, grsnet,
pacamt, swpamt)
tbl2dat = Array(trow, fundnam2, fundnoA, fundnoB)
Call tbl_data(tbl1dat, tbl2dat, rwadd, numrws)
End If 'counter,17 0


Label2:
Next counter


'close excel application and workbook without changes made for retrieving data

'copy last document
Call copy_doc("DONE")

XLBook.Close savechanges:=False
XLBook1.Close savechanges:=False
XLBook2.Close savechanges:=False

Set XLBook = Nothing
Set XLBook1 = Nothing
Set XLBook2 = Nothing
Set XLSheet = Nothing
Set XLSheet1 = Nothing
Set XLSheet2 = Nothing
Set XLrng = Nothing
Set XLrng1 = Nothing

Call cls_docs
End Sub
'Goes back to userform3 to do the mail merge (if they click no to not do the
mail merge this cmdbtn click procedure )

Private Sub CmdBtnNO_Click()
UserForm3.Hide
Documents("Step 2.doc").Activate
ActiveWindow.Close savechanges:=wdDoNotSaveChanges

XLBookENG.Close savechanges:=False
XLBookFRE.Close savechanges:=False
XLBook2.Close savechanges:=False
AppXL.Quit

Set XLBookENG = Nothing
Set XLBookFRE = Nothing

Set XLShtEng = Nothing
Set XLShtFre = Nothing
End Sub

'If Mail merge is yes and englixh and french files are entered in userform
they are passed to this procedure that runs this code with AppXL still open)

sub do_mail_merge(mrgfile_eng, mrgfile_fre)
Dim docname As String
Dim dtasrc As String
Dim filecnt As Long

XLShtEng.Activate
lislrow = XLShtEng.Range("A65536").End(xlUP).Row
If lislrow = 2 Then
docname = mrgfile_eng
dtasrc = "C:\Model Pilot\EngMrg.xls"
filecnt = 1
GoTo labelZ
End If

labelZ:

Documents.Open (docname)
'Documents(docname).Activate
With ActiveDocument.MailMerge
.OpenDataSource name:=dtasrc, _
ConfirmConversions:=False, ReadOnly:=True, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="",
PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="",
Revert:=False, _
Format:=wdOpenFormatAuto, Connection:="Enitre Spreadsheet" _
, SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:=""
.Destination = wdSendToNewDocument
.Execute
End With
Documents(docname).Activate
ActiveDocument.Close wdDoNotSaveChanges


If filecnt < 2 Then
lislrow = 0
XLShtFre.Activate
lislrow = XLShtFre.Range("A65536").End(xlUP).Row
If lislrow = 2 Then
docname = mrgfile_fre
dtasrc = "C:\Model Pilot\FreMrg.xls"
filecnt = filecnt + 1
GoTo labelZ
End If
End If

XLBookENG.Close savechanges:=False
XLBookFRE.Close savechanges:=False
AppXL.Quit

Set XLBookENG = Nothing
Set XLBookFRE = Nothing

Set XLShtEng = Nothing
Set XLShtFre = Nothing

End Sub

"Dick Kusleika" wrote:

Heather

Can you post the code you're using? Maybe someone can spot the problem. As
Tom said, it's usually an unqualified object reference that's creating a
whole new instance and you're not aware of it. He used the unfortunate
example of Range which is also a Word object, but his point is valid.

You could try to use GetObject instead of CreateObject, but you'd just be
masking the underlying problem.

--
Dick Kusleika
Excel MVP
Daily Dose of Excel
www.dicks-blog.com

HeatherO wrote:
Does the 2000 version have a task manager. I've just been restarting
my computer as for the code I will have to go through and check it
carefully. I did close the workbooks and reset the objects to
nothing but I will recheck. Can you think of any reason though why
sometimes when I tried to open a certain workbook it failed to open
it. Yet if I copied the data to a new workbook and saved it under a
new name it opened it no problem?
Thanks for your help
Heather

"Tom Ogilvy" wrote:

Go into the task manager. There are probably many instances of
Excel still running. You code is probably not releasing Excel
because it has created ghost references which can't be released or
you just plain old haven't put in the code to release the
references. (setting variables to nothing in reverse order to the
way they were created and quiting the Excel application.)

This can be subtle.

xlApp.ActiveSheet.Range("A1").Sort Key1:=Range("A1")

would create a ghost reference because the Range("A1") is not
qualified all the way back to a releasable reference

xlApp.Activesheet.Range("A1").Sort
Key1:=xlApp.Activesheet.Range("A1")

would be the fix.

--
Regards,
Tom Ogilvy

"HeatherO" wrote in message
...
I have used late binding to access excel workbooks from my word
macro. The problem I appear to be having is that when I run the
macro the first time it runs smoothly. However if I run it again
some of my files (ones for the mail merge) are locked and won't
open when I am trying to open them in the macro. I do have it in my
code to close those workbooks and quit the application. Is there
any way to test for the workbook.open command failing when it
doesn't open a workbook for this reason? Is there a way of
opening a workbook so that you would not get the locked for editing
by another user and notification of when it's available message?
Also when the macro bombs all the files and application are left
open causing errors when I am trying to debug it again, is there
any quick fix to clean up the files and close the application if
the macro bombs before it has a chance to do those things?
Any help is appreciated.
Thanks,
Heather