Starting Excel from Word

[MichaelS_]

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\IntCoverage.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"
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

i = i + 1

Loop Until xfilename = ""

objXLApp.Quit
Set objXLApp = Nothing

Application.DisplayAlerts = True

End Sub

[NickHK]

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 are:
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\IntCoverage.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_" <[email protected]> wrote
in message news:[email protected]...
>
> 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\IntCoverage.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
>

[MichaelS_]

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\IntCompanies\_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

[NickHK]

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_" <[email protected]> wrote
in message news:[email protected]...
>
> 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\IntCompanies\_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
>

[MichaelS_]

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