Hi

The idea behind the code below is to open an Excel sheet from Word. Th
Excel Sheet serves as an ini-file. The Excel is opened as visible
false. So far the code is working. But my problem is (see the bol
passages) the "i"-counter. It changes but the value in xfilenam
"xfilename
objXLApp.workbooks("IntCoverage.xls").Worksheets(" Coverage").Range("G
& i) & ".doc" stays always the same. If I open the Excel with visible
true it works. Is there also a solution with visible = false?

Thanks for you help
Michael




Sub Update()

Dim savename As String
Dim xfilename As String
Dim macro_name As String
Dim i As Integer

Dim objXLApp As Object
Set objXLApp = CreateObject(Class:="Excel.Application")
objXLApp.workbooks.Ope
("R:\APS\AMR\REPB\IntCompanies\_Companies\IntCover age.xls")

i = 9

Do
'objXLApp.workbooks.Active
XFILENAME
OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"G\
& I) & \".DOC\"
MACRO_NAME
OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"E\
& I) & \"_\"
SAVENAME
OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"C\
& I) & \"_1.DOC\"[/b]
IF XFILENAME = \".DOC\" THEN EXIT DO

DIM FS, F
SET FS = CREATEOBJECT(\"SCRIPTING.FILESYSTEMOBJECT\")
SET F = FS.GETFOLDER(XFILENAME)

IF FS.FILEEXISTS(XFILENAME) = TRUE THEN
DOCUMENTS.OPEN FILENAME:=(XFILENAME)

APPLICATION.RUN MACRONAME:=(MACRO_NAME)
ACTIVEDOCUMENT.SAVE

CHANGEFILEOPENDIRECTOR
\"R:\APS\AMR\REPB\INTCOMPANIES\_UPDATE\\"
ACTIVEDOCUMENT.SAVEAS FILENAME:=(SAVENAME)
FILEFORMAT:=WDFORMATDOCUMENT, _
LOCKCOMMENTS:=FALSE, PASSWORD:=\"\", ADDTORECENTFILES:=TRUE
WRITEPASSWORD _
:=\"\", READONLYRECOMMENDED:=FALSE, EMBEDTRUETYPEFONTS:=FALSE
_
SAVENATIVEPICTUREFORMAT:=FALSE, SAVEFORMSDATA:=FALSE
SAVEASAOCELETTER:=FALSE

ACTIVEDOCUMENT.CLOSE SAVECHANGES:=WDDONOTSAVECHANGES

END IF

[b] I = I +

Loop Until xfilename = ""

objXLApp.Quit
Set objXLApp = Nothing

Application.DisplayAlerts = True

End Su

--
MichaelS
-----------------------------------------------------------------------
MichaelS_'s Profile: http://www.excelforum.com/member.php...fo&userid=2640
View this thread: http://www.excelforum.com/showthread.php?threadid=51716

Michael,
Not sure how you managed to get this code to/from VBA IDE, with all the
capitals and "\", but...
A couple of thing that may help a
Use a reference to Excel so you benefit from Intellisense and early binding.
Give yourself a Workbook and Worksheet object to work, to shorten code.
e.g. Set MyXLWorkbook as Excel.Workbook....etc
Don't Dim you variable in a loop, (and no need to ChangeFileOpenDirectory
everytime) and the FSO is not needed to check if a file exist; there are
native VB ways, check Google.

Dim objXLApp As Excel.Application
Dim objXLWB As Excel.Workbook
Dim objXLWS As Excel.Worksheet

Set objXLApp = New Excel .Application
Set objXLWB = objXLApp.workbooks.Open
("R:\APS\AMR\REPB\IntCompanies\_Companies\IntCover age.xls")
Set objXLWS = objXLWB.Worksheets("COVERAGE")

ChangeFileOpenDirectory "R:\APS\AMR\REPB\INTCOMPANIES\_UPDATE\"
With objXLWS.Range("C9")
Do
savename=.Offset(i,0).Value & "_1.DOC"
macro_name=.Offset(i,2).Value & "_"
xfilename = Offset(i,4).Value & ".DOC"
If YourFileExistRoutine(xfilename)=True Then
...Do the Word stuff
Else
Exit Do
End If
i=i+1
Loop
End With

NickHK

"MichaelS_" wrote
in message ...

Hi

The idea behind the code below is to open an Excel sheet from Word. The
Excel Sheet serves as an ini-file. The Excel is opened as visible =
false. So far the code is working. But my problem is (see the bold
passages) the "i"-counter. It changes but the value in xfilename
"xfilename =
objXLApp.workbooks("IntCoverage.xls").Worksheets(" Coverage").Range("G"
& i) & ".doc" stays always the same. If I open the Excel with visible =
true it works. Is there also a solution with visible = false?

Thanks for you help
Michael




Sub Update()

Dim savename As String
Dim xfilename As String
Dim macro_name As String
Dim i As Integer

Dim objXLApp As Object
Set objXLApp = CreateObject(Class:="Excel.Application")
objXLApp.workbooks.Open
("R:\APS\AMR\REPB\IntCompanies\_Companies\IntCover age.xls")

i = 9

Do
'objXLApp.workbooks.Active
XFILENAME =

OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"G\"
& I) & \".DOC\"
MACRO_NAME =

OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"E\"
& I) & \"_\"
SAVENAME =

OBJXLAPP.WORKBOOKS(\"INTCOVERAGE.XLS\").WORKSHEETS (\"COVERAGE\").RANGE(\"C\"
& I) & \"_1.DOC\"[/b]
IF XFILENAME = \".DOC\" THEN EXIT DO

DIM FS, F
SET FS = CREATEOBJECT(\"SCRIPTING.FILESYSTEMOBJECT\")
SET F = FS.GETFOLDER(XFILENAME)

IF FS.FILEEXISTS(XFILENAME) = TRUE THEN
DOCUMENTS.OPEN FILENAME:=(XFILENAME)

APPLICATION.RUN MACRONAME:=(MACRO_NAME)
ACTIVEDOCUMENT.SAVE

CHANGEFILEOPENDIRECTORY
\"R:\APS\AMR\REPB\INTCOMPANIES\_UPDATE\\"
ACTIVEDOCUMENT.SAVEAS FILENAME:=(SAVENAME),
FILEFORMAT:=WDFORMATDOCUMENT, _
LOCKCOMMENTS:=FALSE, PASSWORD:=\"\", ADDTORECENTFILES:=TRUE,
WRITEPASSWORD _
:=\"\", READONLYRECOMMENDED:=FALSE, EMBEDTRUETYPEFONTS:=FALSE,
_
SAVENATIVEPICTUREFORMAT:=FALSE, SAVEFORMSDATA:=FALSE,
SAVEASAOCELETTER:=FALSE

ACTIVEDOCUMENT.CLOSE SAVECHANGES:=WDDONOTSAVECHANGES

END IF

[b] I = I + 1

Loop Until xfilename = ""

objXLApp.Quit
Set objXLApp = Nothing

Application.DisplayAlerts = True

End Sub


--
MichaelS_
------------------------------------------------------------------------
MichaelS_'s Profile:
http://www.excelforum.com/member.php...o&userid=26406
View this thread: http://www.excelforum.com/showthread...hreadid=517163

Hi

I changed the code, but now I get an other error message (Obect
required) and the debugger stops at red line. Does anybody has an idea
why?

Thanks a lot
Michael



Sub Update()

Dim savename As String
Dim xfilename As String
Dim macro_name As String
Dim i As Integer

Dim objXLApp As Object
Dim objXLWB As Object
Dim objXLWS As Object
Dim objXLCELL As Object

Set objXLApp = CreateObject(class:="Excel.application")
Set objXLWB =
objXLApp.WORKBOOKS.Open("R:\APS\AMR\REPB\IntCompan ies\_Companies\IntCoverage.xls")
Set objXLWS = objXLWB.Worksheets("COVERAGE")
Set objXLCELL = objXLWS.Range("G9")

Do

xfilename = objXLCELL.Offset(i, 0).Value & ".doc"
macro_name = objXLCELL.Offset(i, -2).Value & "_"
savename = objXLCELL.Offset(i, -4).Value & "_1.doc"


If xfilename = ".doc" Then Exit Do

Documents.Open FileName:=(xfilename)
Application.Run MacroName:=(macro_name)
ActiveDocument.Save

ActiveDocument.SaveAs
FileName:=(("R:\APS\AMR\REPB\INTCOMPANIES\_UPDATE\ ") & (savename))
ActiveDocument.Close Savechanges:=wdDoNotSaveChanges

i = i + 1

Loop Until xfilename = ""

objXLApp.Quit
Set objXLApp = Nothing

End Sub


--
MichaelS_
------------------------------------------------------------------------
MichaelS_'s Profile: http://www.excelforum.com/member.php...o&userid=26406
View this thread: http://www.excelforum.com/showthread...hreadid=517163

Michael,
Depending exact where the error happens, it means that, for some reason, an
object that expected to be created was not.
This is probably because the XL file name is wrong, the ws "COVERAGE" does
not exist,..etc.

So check that all the are not Nothing.

It is probably a good idea to explicitly set all your object to Nothing, not
only XLApp.
Also .Close the WB.

Also, your loop will never actually terminate because of the Loop Until
xfilename = "".
It wuill have exited before that with If xfilename = ".doc" Then Exit Do.
So you could you use Do..Loop.

NickHK

"MichaelS_" wrote
in message ...

Hi

I changed the code, but now I get an other error message (Obect
required) and the debugger stops at red line. Does anybody has an idea
why?

Thanks a lot
Michael



Sub Update()

Dim savename As String
Dim xfilename As String
Dim macro_name As String
Dim i As Integer

Dim objXLApp As Object
Dim objXLWB As Object
Dim objXLWS As Object
Dim objXLCELL As Object

Set objXLApp = CreateObject(class:="Excel.application")
Set objXLWB =

objXLApp.WORKBOOKS.Open("R:\APS\AMR\REPB\IntCompan ies\_Companies\IntCoverage
..xls")
Set objXLWS = objXLWB.Worksheets("COVERAGE")
Set objXLCELL = objXLWS.Range("G9")

Do

xfilename = objXLCELL.Offset(i, 0).Value & ".doc"
macro_name = objXLCELL.Offset(i, -2).Value & "_"
savename = objXLCELL.Offset(i, -4).Value & "_1.doc"


If xfilename = ".doc" Then Exit Do

Documents.Open FileName:=(xfilename)
Application.Run MacroName:=(macro_name)
ActiveDocument.Save

ActiveDocument.SaveAs
FileName:=(("R:\APS\AMR\REPB\INTCOMPANIES\_UPDATE\ ") & (savename))
ActiveDocument.Close Savechanges:=wdDoNotSaveChanges

i = i + 1

Loop Until xfilename = ""

objXLApp.Quit
Set objXLApp = Nothing

End Sub


--
MichaelS_
------------------------------------------------------------------------
MichaelS_'s Profile:
http://www.excelforum.com/member.php...o&userid=26406
View this thread: http://www.excelforum.com/showthread...hreadid=517163

Hi Nick

Thanks for you ongoing help.

Is it strange, but the first do loop works perfectly, then the counter
„i“ will be increased. The next do until loop does not work anymore.

I get the impression that the word lost the connection to the excel
sheet object.

Best regards & have a nice weekend
Michael


--
MichaelS_
------------------------------------------------------------------------
MichaelS_'s Profile: http://www.excelforum.com/member.php...o&userid=26406
View this thread: http://www.excelforum.com/showthread...hreadid=517163