Re: Solution: Scripting Excel without the usual problems :)
Benny Pedersen
instead).
Fact is that I could not force the msgBox "", 4112 to be executed, so
you should
never see the 4112 message :)
As said; The sub "OpenExcelSheet" is constructed to open whatever xls
file
without problems such as the reopen prompt, etc...
Benny,
www.fineraw.com
option explicit
dim oExcelApp, oExcelSheet
OpenExcelSheet "C:\Target\SLET.XLS"
dim ActiveRow, ActiveCol
with oExcelApp.ActiveCell
ActiveRow= .Row
ActiveCol= .Column
.value= "Test"
.Interior.ColorIndex= 19
.Font.ColorIndex= 23
msgBox ActiveRow & " " & ActiveCol, 4096, .value
end with
sub OpenExcelSheet(byVal sFile) dim s, fso
if IsExecuting("excel.exe") then
set oExcelApp= getObject (, "excel.application")
else set oExcelApp= createObject("excel.application")
end if
set fso= createObject("scripting.fileSystemObject")
if fso.fileExists(sFile) then
s= fso.getFileName(sFile)
on error resume next: oExcelApp.windows(s).activate
if uCase(oExcelApp.activeWorkBook.fullName) _
<> uCase(sFile) then oExcelApp.workbooks.open sFile
on error goto 0
else s= fso.getParentFolderName(sFile)
if not fso.folderExists(s) then fso.createFolder(s)
createObject("excel.sheet").saveAs sFile
oExcelApp.workbooks.open sFile
end if
' set oExcelSheet= oExcelApp.activeWorkBook.workSheets(1)
oExcelApp.visible= true
if uCase(oExcelApp.activeWorkBook.fullName) <> uCase(sFile) _
then msgBox """" & sFile & """", 4112: wScript.quit
end sub
function IsExecuting(byVal sProc)
dim oList: set oList= getObject("winmgmts:").execQuery(_
"select * from win32_process where name='"& sProc &"'")
if oList.count > 0 then IsExecuting= true
end function
On Mar 7, 7:41 pm, Benny Pedersen <b.peder...@get2net.dk> wrote:
> On Mar 7, 7:36 am, Benny Pedersen <b.peder...@get2net.dk> wrote:
>
>
>
>
>
> > Hi
> > Lets say we wrote a script which we use to write into one sheet.
>
> > We maybe had opened 50 different sheets, but the script should only
> > write to one uniq sheet, or/and the user maybe also write something
> > to his open sheet(s) before, after or while running the script,
> > or he just run it. Hmm, Excel maybe is installed, or he
> > just say: "What is Excel"...
> > Maybe we again would like to repeat the script, etc.. and so on...
> > BUT for sure he will (+ me and you, and all the other), soon see
> > a lot of invisible and frozen Excel sheets (Microsoft). Some sheets
> > he also saw was damaged. The script just failed... Hmm, The below
> > function "OpenExcelSheet" (line no. 23) is created to avoid most
> > such problems... (Ok, newbee tried). You could Open, modify, Close,
> > or Delete your sheets, anyhow the script should just continue
> > whatever job; Write stuff to the one sheet only.
>
> > Benny,www.fineraw.com
> > PS: Hope my VBS is better than me english...
>
> > 01 option explicit
> > 02 dim fso, wso, oExcelApp, oExcelSheet, ActiveRow, ActiveCol
> > 03 dim i, sFile : sFile= "C:\Target\SLET.XLS"
> > 04 set fso= createObject("scripting.fileSystemObject")
> > 05 set wso= createObject("wScript.shell")
> > 06
> > 07 OpenExcelSheet sFile ' Just specify a filename (line no. 3)!
> > 08
> > 09 ActiveRow= oExcelApp.ActiveCell.Row
> > 10 ActiveCol= oExcelApp.ActiveCell.Column
> > 11 msgBox ActiveRow & " " & ActiveCol, 4096
> > 12
> > 13 for i= 1 to 56
> > 14 oExcelSheet.Cells(i,1)= i
> > 15 oExcelSheet.Cells(i,1).Interior.ColorIndex= i
> > 16 next
> > 17
> > 18 for i= 1 to 56
> > 19 oExcelSheet.Cells(i,2)= i
> > 20 oExcelSheet.Cells(i,2).Font.ColorIndex= i
> > 21 next
> > 22
> > 23 sub OpenExcelSheet(byVal sFile)
> > 24 dim sPath: sPath= getF(sFile, "parent")
> > 25 if not fso.folderExists(sPath) then fso.createFolder(sPath)
> > 26 if IsExecuting("excel.exe") = true then
> > 27 set oExcelApp= getObject(, "excel.application"):
> > oExcelApp.visible= true
> > 28 if not fso.fileExists(sFile) then createObject
> > ("excel.sheet").saveAs sFile
> > 29 on error resume next'...because Excel could already be opened
> > but without a sheet.
> > 30 if lCase(oExcelApp.activeWorkBook.FullName) <> lCase(sFile) _
> > 31 then oExcelApp.workbooks.open(sFile)
> > 32 on error goto 0
> > 33 ' Without the repeated line below, the script could write to
> > another open sheet;
> > 34 ' which modified by the user (said NO to the Excel-prompt about
> > reopen).
> > 35 if lCase(oExcelApp.activeWorkBook.FullName) <> lCase(sFile) _
> > 36 then msgBox "In order to work, please close the other" _
> > 37 & " sheet(s)... Then repeat the script.", 4096, "Script
> > Aborted" _
> > 38 : wScript.quit' Maybe rare; but was seen while testing.
> > 39 else set oExcelApp= createObject("excel.application"):
> > oExcelApp.visible= true
> > 40 if not fso.fileExists(sFile) then createObject
> > ("excel.sheet").saveAs sFile
> > 41 oExcelApp.workbooks.open(sFile)
> > 42 end if
> > 43 set oExcelSheet= oExcelApp.activeWorkBook.workSheets(1)'?
> > 44 end sub
> > 45
> > 46 function getF(byVal sFSpec, byVal sWhat)
> > 47 sWhat= lCase(sWhat)
> > 48 sFSpec= wso.expandEnvironmentStrings(sFSpec)
> > 49 sFSpec= fso.getAbsolutePathName(sFSpec)
> > 50 select case sWhat
> > 51 case "base" getF= fso.getBaseName(sFSpec)
> > 52 case "filename" getF= fso.getFileName(sFSpec)
> > 53 case "extension" getF= fso.getExtensionName(sFSpec)
> > 54 case else on error resume next
> > 55 if sWhat="file" then
> > 56 getF= fso.getFile(sFSpec)
> > 57 else :
> > 58 if sWhat="parent" then sFSpec= fso.getParentFolderName(sFSpec)
> > 59 sFSpec= fso.buildPath(sFSpec,"\")
> > 60 getF= fso.buildPath(fso.getFolder(sFSpec),"\")
> > 61 end if
> > 62 if err then getF= sFSpec: err.clear
> > 63 end select
> > 64 end function
> > 65
> > 66 function IsExecuting(byVal sProc)
> > 67 dim oList: set oList= getObject("winmgmts:").execQuery(_
> > 68 "select * from win32_process where name='"& sProc &"'")
> > 69 if oList.count > 0 then IsExecuting= true
> > 70 end function
>
> OOPS: Line no. 43 should be:
>
> 43 set oExcelSheet= oExcelApp.activeWorkBook.workSheets(1):
> oExcelApp.visible= true- Hide quoted text -
>
> - Show quoted text -