Help with borders

Ed · Jul 22, 2003

In vbscript, how would I put a thin border on top and a thick border on the
bottom of the active cell? The macro wizard wants to use selected cell.

Thanks in Advance.

Ed · Jul 22, 2003

Thanks, but that dosn't work. I am trying to include it in my sub;

Sub Write4CellAdvBdr(SheetName,Val1,Val2,Val3,Val4)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(0,3).Value = Val4
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Ed · Jul 23, 2003

Anyone else have any ideas?

Ed · Jul 25, 2003

That would defeat my script, but thanks. My script writes information about
the workstation, then advances to the next line, to write information about
the next workstation. Enclosed is my script, which will soon be on
sourforge.net.

'******************************************************************
' Program: HotFixDistro.vbs
'
' Version: 1.00
'
' Changes: 0.01 Removed Broke Subs, Added Subs for WriteAndAdvance
' : 0.02 WMI patch now required for some functions in NT4
' : 0.03 Adding functions for getting info on machines
' : listing not installed HF.
' : 1.00 This version seems to have basic funtionality
' : the first full version, please point me to new features
' : and broken functions.
'
' Thanks To: Mark Hauschild
' : Rick Henry
' : nntp://msnews.microsoft.com
' : -Torgeir Bakken (MVP) <[email protected]>
' : -Michael Harris (MVP) <[email protected]>
' : -|{evin <[email protected]>
' : -Joe (Joe'Software - www.jsware.net)
' : http://www.crimsoneditor.com
' : http://cwashington.netreach.net/main/default.asp?topic=news
' : http://www.thekurt.net/NetworkUtilities.htm
'
' Programmer: Edwin Holley
' Date: 10APR03
'
' Description: The primary purpose of this script is to distribute hotfixes
' in a Windows NT4 domain. This task requires the ability to copy files
from
' the local machine to a remote machine. Programs may then be ran on the
' remote machine, with the www.sysinternals.com program called psexec.exe.
' Other methods may be used as desired. This script currently sends output
' to Excel tabs, Fail pass and summary. Allowing the machines that did not
' pass to be tackled later. This script uses hfnetchk www.shavlik.com to
' list the hotfixes that need to be installed on each machine. I would like
' each hotfix to be deployed automatically as an option.
'******************************************************************

'Instructions for use.
'
'First create a machinestofix.txt
' net view > machinestofix.txt
' notepad machinestofix.txt
' Delete all lines but the ones containing computer "\\{machine name}"
' do a search and replace for "\\" replace with "" nothing
' replace all
' Remove any machines that are not standard (i.e. linux\solaris\etc)
' Save file
'Second the files
' put the script on a machine that has excel
' copy the hotfix file to the c:\temp of the machine script will be run from
' Place the machinestofix.txt file in the same directory as the script
' obtain a copy of the pstools from www.sysinternals.com ensure that command
' "psexec.exe" is in the path.
'Third Log in as a domain admin on the machine with the script

'Constants
'Should either notify be set to true, their will be an sound based indicator
for success or failure
' an error will be recieved if the file does not exist in the media
directory. Please check before
' running the script.

Const NOTIFY_ADMIN_SUCCESS = False
Const NOTIFY_ADMIN_FAILURE = True
Const NOTIFY_ON_COMPLETION = True
Const SUMMARY_OF_WORK = True
Const RESUME_ON_ERROR = True
Const MAIL_ON_COMPLETION = False

If RESUME_ON_ERROR Then
On Error Resume Next
End If

' Machines To Fix
TextFileIntoArray "machinestofix.txt", List
' Run "netcomputers /domain:vrc40 /type:workstation /nocomment", ListRaw
' ListAr = Split(ListRaw, vbCrlf)
' RegExpression "[1-9]\.[0-9]{4}",ListAr, List

'Set up the Excel Object
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

'>>Set up the failure worksheet
RenameWorksheet "Sheet1", "Failure"
WriteCellLoc "A1", "Count", "True"
WriteCellLoc "A2", "Machine", "True"
FormatRange "A:A", "", "13"
WriteCellLoc "B1", "=COUNTA(A3:A200)", "False"
WriteCellLoc "B2", "Error", "True"
FormatRange "B:B", "", "90"
GotoCell "A3"

'>>Set up the Success worksheet
RenameWorksheet "Sheet2", "Success"
WriteCellLoc "A1", "Count", "True"
WriteCellLoc "B1", "=COUNTA(A3:A200)", "False"
WriteCellLoc "A2", "Machine", "True"
FormatRange "A:A", "", "21"
FormatRange "B

", "", "51"
GotoCell "A3"

If SUMMARY_OF_WORK Then
'>>Set up Summary Worksheet
RenameWorksheet "Sheet3", "Summary"
WriteCellLoc "A1", "Success", "True"
WriteCellLoc "A2", "Failure", "True"
WriteCellLoc "A3", "Total", "True"
WriteCellLoc "B1", "=Success!B1+0", "False"
WriteCellLoc "B2", "=Failure!B1+0", "False"
WriteCellLoc "B3", "=B1+B2", "False"
WriteCellLoc "C1", "=B1/B3", "False"
WriteCellLoc "C2", "=B2/B3", "False"
FormatRange "C1:C2", "0.0%", ""

Else
'Trim the fat
DeleteWorksheet "Sheet3"

End If

'Process the machines in the list one by one
For Each Computer in List
'Skip null value
Select Case Computer
Case ""
Exit For
End Select

' InternetExp Computer,IEver
' ServicePack Computer,SPver
' OSVersion Computer,OSver
' MissingHFQ Computer,RetHFar,ReturnHF,RetHFnum
' DinkHFQ Computer,RetHFar,ReturnHF,RetHFnum
InstalledSW Computer,RetSWar,RetSWarCnt

'Desired command on remote computer
' FileCopy "c:\temp\Q810833i.EXE", Computer & "\c$\temp\Q810833i.EXE", True
' FileCopy "c:\temp\Q810833i.cmd", Computer & "\c$\temp\Q810833i.cmd", True

' ClearSub "\\" & Computer & "\C$\Temp\*.*"
' ClearSub "\\" & Computer & "\C$\WINNT\Temp\*.*"

' FileCopy
"C:\@PatchDeployment\NT4\WinSec-MS03-007-003-P13391-Q815021int40.EXE", "\\"
& Computer & "\c$\temp\WinSec-MS03-007-003-P13391-Q815021int40.EXE", True
' FileCopy "C:\@PatchDeployment\IE 6.0.2 SP1.exe.lnk", "\\" & Computer &
"\c$\winnt\profiles\administrator\desktop\IE 6.0.2 SP1.exe.lnk", True

' FileCopy
"C:\@PatchDeployment\IE60SP1\WinSec-MS03-020-003-P14614-q818529ie6sp1.exe",
"\\" & Computer & "\c$\temp\WinSec-MS03-020-003-P14614-q818529ie6sp1.exe",
True
' FileCopy
"C:\@PatchDeployment\NT4\WinSec-MS03-007-003-P13391-Q815021int40.EXE.lnk",
"\\" & Computer & "\c$\winnt\profiles\administrator\desktop\WinSec-MS03-007-
003-P13391-Q815021int40.EXE.lnk", True
'
' FileCopy "C:\@PatchDeployment\IE 6.0.2 SP1.exe", "\\" & Computer &
"\c$\temp\IE 6.0.2 SP1.exe", True
' FileCopy
"C:\@PatchDeployment\IE60SP1\WinSec-MS03-020-003-P14614-q818529ie6sp1.exe.ln
k", "\\" & Computer &
"\c$\winnt\profiles\administrator\desktop\WinSec-MS03-020-003-P14614-q818529
ie6sp1.exe.lnk", True

' RunCommand "psexec " & Computer & " c:\temp\Q810833i.cmd"
' RunCommand "net send " & Computer & " {{Please reboot As soon As possible
To complete sys maint[IT]}}"

' Check for errors.
If Err.Number <> 0 Then
EnumerateError ErrorDetail

Write2CellAdv "Failure", Computer, ErrorDetail

If NOTIFY_ADMIN_FAILURE Then
PlayWav "C:\WINNT\Media\chord.wav"
End If
Else

WriteCellAdv "Success", Computer
' Write4CellAdv "Success", Computer, OSver, SPver, IEver

PrintLots3 "Success", RetSWar

If NOTIFY_ADMIN_SUCCESS Then
PlayWav "C:\WINNT\Media\ding.wav"
End If
End If

'Clear Variables
Err.Number = 0
strError = ""
Next

If SUMMARY_OF_WORK Then
' Create a new sheet to summarize results of run
' objExcel.Worksheet.Add
objExcel.Sheets("Summary").Select

End If

If NOTIFY_ON_COMPLETION Then
'Make Noise
PlayWav "C:\WINNT\Media\Windows Logoff Sound.wav"
End If

If MAIL_ON_COMPLETION Then
'Send Mail
SendMail "edwin.holley", "zebra654", "(e-mail address removed)", "This is a
test"
End If

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<End of SCRIPT
Function TextFileIntoArray(FileName,ArrayName)
ArrayName = ""
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oList = oFSO.OpenTextFile(FileName, 1, False, False)
ArrayName = Split(oList.ReadAll, vbCrlf)
oList.Close
FileName = ""
End Function

Sub FormatRange(Range,Format,Width)
objExcel.ActiveSheet.Range(Range).Select
If Format <> "" Then
objExcel.Selection.NumberFormat = Format
End If
If Width <> "" Then
objExcel.Columns(Range).ColumnWidth = Width
End If
End Sub

Sub PlayWav(sWaveFile)
Set oShell = CreateObject("Wscript.Shell")
oShell.Run "sndrec32 /play /close """ & sWaveFile & """",0,True
End Sub

Sub WriteCellLoc(Loc,Value,Bold)
objExcel.ActiveSheet.Range(Loc).Activate
objExcel.ActiveCell.Value = Value
objExcel.ActiveCell.Font.Bold = Bold
End Sub

Sub WriteCellAdv(SheetName,Val1)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub Write2CellAdv(SheetName,Val1,Val2)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub Write3CellAdv(SheetName,Val1,Val2,Val3)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub Write4CellAdv(SheetName,Val1,Val2,Val3,Val4)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(0,3).Value = Val4
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub Write5CellAdv(SheetName,Val1,Val2,Val3,Val4,Val5)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(0,3).Value = Val4
objExcel.ActiveCell.Offset(0,4).Value = Val5
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub Write6CellAdv(SheetName,Val1,Val2,Val3,Val4,Val5,Val6)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(0,3).Value = Val4
objExcel.ActiveCell.Offset(0,4).Value = Val5
objExcel.ActiveCell.Offset(0,5).Value = Val6
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub
Write21CellAdv(SheetName,Val1,Val2,Val3,Val4,Val5,Val6,Val7,Val8,Val9,Val10,
Val11,Val12,Val13,Val14,Val15,Val16,Val17,Val18,Val19,Val20,Val21)
objExcel.Sheets(SheetName).Select
objExcel.ActiveCell.Value = Val1
objExcel.ActiveCell.Offset(0,1).Value = Val2
objExcel.ActiveCell.Offset(0,2).Value = Val3
objExcel.ActiveCell.Offset(0,3).Value = Val4
objExcel.ActiveCell.Offset(0,4).Value = Val5
objExcel.ActiveCell.Offset(0,5).Value = Val6
objExcel.ActiveCell.Offset(0,6).Value = Val7
objExcel.ActiveCell.Offset(0,7).Value = Val8
objExcel.ActiveCell.Offset(0,8).Value = Val9
objExcel.ActiveCell.Offset(0,9).Value = Val10
objExcel.ActiveCell.Offset(0,10).Value = Val11
objExcel.ActiveCell.Offset(1,0).Activate
objExcel.ActiveCell.Value = ""
objExcel.ActiveCell.Offset(0,2).Value = Val12
objExcel.ActiveCell.Offset(0,3).Value = Val13
objExcel.ActiveCell.Offset(0,4).Value = Val14
objExcel.ActiveCell.Offset(0,5).Value = Val15
objExcel.ActiveCell.Offset(0,6).Value = Val16
objExcel.ActiveCell.Offset(0,7).Value = Val17
objExcel.ActiveCell.Offset(0,8).Value = Val18
objExcel.ActiveCell.Offset(0,9).Value = Val19
objExcel.ActiveCell.Offset(0,10).Value = Val20
objExcel.ActiveCell.Offset(0,11).Value = Val21
objExcel.ActiveCell.Offset(1,0).Activate
End Sub

Sub GotoWorksheet(SheetName)
objExcel.Sheets(SheetName).Select
objExcel.ActiveSheet.Range("A1").Activate
End Sub

Sub RenameWorksheet(OldSheet, NewSheet)
objExcel.Sheets(OldSheet).Select
objExcel.ActiveSheet.Name = NewSheet
objExcel.ActiveSheet.Range("A1").Activate
End Sub

Sub GotoCell(Location)
objExcel.ActiveSheet.Range(Location).Activate
End Sub

Sub AdvanceLine(Down,Across)
objExcel.ActiveCell.Offset(Down, Across).Activate
End Sub

Sub MilDate(Variable)
Variable = Day(Now) & Left(Month(Now), 3) & Right(Year(Now), 2)
End Sub

Sub ClearScheduledEvents(strComputer)
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colScheduledTasks = objWMIService.ExecQuery _
("Select * from Win32_ScheduledJob")
For Each objTask In colScheduledTasks
intJobID = objTask.JobID
Set objInstance = objWMIService.Get("Win32_ScheduledJob.JobID=" &
intJobID)
objInstance.Delete
Next
End Sub

Sub FileCopy(Source,Destination,Overwrite)
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile Source, Destination, Overwrite
End Sub

Sub RunCommand(cmd)
Set oshell = wscript.createobject("Wscript.Shell")
oShell.Run( cmd )
End Sub

Const TEMP_FOLDER = 2
Const FOR_READING = 1
Const FOR_WRITING = 2

Function Run(sCmd, sOutput)

Dim fso, fldTemp, sTempName

set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(TEMP_FOLDER)
sTempName = fldTemp.Path & "\" & fso.GetTempName

'Run the command
Dim WshShell
Set WshShell = CreateObject("Wscript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
If WshSysEnv("OS") = "Windows_NT" then
Run = WshShell.Run( "cmd /c " & sCmd & " >" & sTempName, 0, True )
Else
Run = Run95(sCmd, sTempName)
End If

'Get the output from the command
Dim filOutput
Set filOutput = fso.OpenTextFile(sTempName, FOR_READING)
While Not filOutput.AtEndOfStream
sOutput = sOutput & filOutput.ReadLine
Wend
filOutput.Close

'Delete the temporary file
fso.DeleteFile sTempName

End Function

'Windows 9x requires an intermediate batch file
Function Run95(sCmd, sTempName)
'Create th batch file
Dim fso, BatchFile
set fso = CreateObject("Scripting.FileSystemObject")
Set BatchFile = fso.OpenTextFile(sTempName & ".bat", FOR_WRITING,
True )

'Write the command
BatchFile.WriteLine sCmd & " >" & sTempName
BatchFile.Close

'Run the batch file
Dim WshShell
Set WshShell = CreateObject("Wscript.Shell")
Run95 = WshShell.Run( sTempName & ".bat", 0, True )
End Function

Function RegExpression(strMatchPattern,strPhrase,ReturnStr)
' Clean Up
ReturnStr = ""

'create variables
Dim objRegEx, Match, Matches, StrReturnStr
'create instance of RegExp object
Set objRegEx = New RegExp

'find all matches
objRegEx.Global = True
'set case insensitive
objRegEx.IgnoreCase = True
'set the pattern
objRegEx.Pattern = strMatchPattern

'create the collection of matches
Set Matches = objRegEx.Execute(strPhrase)

'collect all matches
For Each Match In Matches
ReturnStr = ReturnStr + Match & ","
Next

' Clean Up
strMatchPattern = ""
strPhrase = ""
End Function

Function EnumerateError(strError)
strError = "(0x" & Right(String(8,"0")_
& Hex(Err.Number),8) & ") :" & Err.Description & ""
End Function

Function InternetExp(Comp,RetIE)
psinfoResult = ""
Run "psinfo \\" & Computer,psinfoResult
RegExpression "[1-9]\.[0-9]{4}",psinfoResult,RetIEwrk
RetIE = Left(RetIEwrk,3)
End Function

Function ServicePack(Comp,RetSP)
psinfoResult = ""
Run "psinfo \\" & Computer,psinfoResult
RegExpression "Service pack:\s*[1-9]",psinfoResult,RetSPwrk
If RetSPwrk <> "" Then
RetSP = "SP" & Left(Right(RetSPwrk,2),1)
Else
RetSP = ""
End If
End Function

Function OSVersion(Comp,RetOS)
psinfoResult = ""
RetOSwrk = ""
Run "psinfo \\" & Computer,psinfoResult
RegExpression "Product version:\s*[1-9]",psinfoResult,RetOSwrk
If RetOSwrk <> "" Then
RetOS1 = Left(Right(RetOSwrk,2),1)
Select Case RetOS1
Case "3"
RetOS = "NT35"
Case "4"
RetOS = "NT40"
Case "5"
RetOS = "W2K"
Case "6"
RetOS = "XP"
Case Else
RetOS = "??"
RetOSwrk = ""
RetSP1 = ""
End Select
Else
RetOSwrk = ""
RetOS1 = ""
RetOS = ""
End If
End Function

Function MissingHFQ(Comp,RetHFar,RetHF,RetHFnum)
RetHF = ""
RetHFar = ""
RetHFnum = ""
hfnetResult = ""
Run "hfnetchk -h " & Comp & " -ms -b -s 2", hfnetResult
RegExpression "[1-9][0-9]{5}",hfnetResult,RetHF
RetHFar = Split(RetHF,",")
RetHFnum = UBound(RetHFar)
End Function

Function MissingHFMS(Comp,RetHFar,RetHF,RetHFnum)
RetHF = ""
RetHFar = ""
RetHFnum = ""
hfnetResult = ""
Run "hfnetchk -h " & Comp & " -ms -b -s 2", hfnetResult
RegExpression "MS[0-9]{2}\-[0-9]{3}",hfnetResult,RetHF
RetHFar = Split(RetHF,",")
RetHFnum = UBound(RetHFar)
hfnetResult = ""
End Function

Function DinkHFQ(Comp,RetHFar,RetHF,RetHFnum)
RetHF = ""
RetHFar = ""
RetHFnum = ""
hfnetResult = ""
Run "hfnetchk -h " & Comp & " -ms -b -s 2", hfnetResult
RegExpression "MS[0-9]{2}\-[0-9]{3}",hfnetResult,RetHF1
arRetHF1 = Split(RetHF1,",")
TextFileIntoArray "hotfixlist.txt", HotFixList
For Each HotFix in HotFixList
arRetHF2 = Filter(arRetHF1,HotFix,True)
RetHF2 = Join(arRetHF2,",")
If RetHF2 <> "" then
RetHF = RetHF + RetHF2 & ","
End If
Next
RetHFar = Split(RetHF,",")
RetHFnum = UBound(RetHFar)
hfnetResult = ""
RetHF1 = ""
End Function

Function InstalledSW(Comp,SoftwareAr,SoftwareArCnt)
RetSW = ""
Run "psinfo -s \\" & Comp,RetSW
RoughApps = split(RetSW,"Applications:")
If UBound(RoughApps) > 0 Then
SoftwareWrk = RoughApps(1)
SoftwareAr = Split(SoftwareWrk, " ")
SoftwareArCnt = UBound(SoftwareAr)

' For Each Package in SoftwareAr
' RegExpression "Windows NT 4.0 Hotfix \[See Q[1-9][0-9]{5} for more
information\]",Package,RetPackage
' Wscript.Echo Package & " " & RetPackage
' SoftwareAr = Filter(SoftwareAr,RetPackage,False)
' If RetPackage <> Package Then
' Software = Software + Package & ","
' End If
' Next

Else
SoftwareWrk = ""
SoftwareAr = ""
SoftwareArCnt = "0"
End If
End Function

Function DoSearch(FolPath, sExtName)
'--///////////////////////////////////////////////////
'-- This Function searches the files in FolPath For a match with sExtName.
'-- It Then calls itself For Each subfolder found.
'-- This can work because Each instance of the Function is a separate
'-- operation that just happens to be called from within the Function.
'-- That is, the variables Fol, SubPath, etc. are separate variables in
'-- Each instance of the Function. Dim SubPath, Fol, s1, sList, oFol,
Fils, oFil, s, sPath, Fols, LExt

Set FSO = CreateObject("Scripting.FileSystemObject")
LExt = Len(sExtName)
sExtName = UCase(sExtName)
Set oFol = FSO.GetFolder(FolPath)
Set Fils = oFol.Files

If Fils.count > 0 Then
For Each oFil in Fils
If UCase(Right(oFil.name, LExt)) = sExtName Then
sList = sList & oFil.Path & vbcrlf
End If
Next
End If

Set Fols = oFol.SubFolders

If Fols.count > 0 Then
For Each Fol in Fols
SubPath = Fol.Path
s1 = dosearch(SubPath, sExtName)
If s1 <> "" Then
sList = sList & s1
End If
Next
End If

Set Fols = Nothing

Set Fils = Nothing
Set oFol = Nothing

DoSearch = sList

End Function

Sub PrintLots2(Sheet,Arr)
Cnt = UBound(Arr)
If Cnt > 0 Then
for i = 1 to Cnt step 2
StartR = i
StartO = Arr(StartR)

If i + 1 > Cnt Then
EndOut = ""
Else
EndRow = i + 1
EndOut = Arr(EndRow)
End If

If Cnt >= EndRow then
Write3CellAdv Sheet,"",StartO,EndOut
End If

If Cnt = StartO Then
Write2CellAdv Sheet,"",StartO
End If
next
StartR = ""
EndRow = ""
StartO = ""
EndOut = ""
Else
Write2CellAdv Sheet,"","xXxXx"
End If
End Sub

Sub PrintLots3(Sheet,Arr)
Cnt = UBound(Arr)
r = 3
rr = r - 1
If Cnt > 0 Then
for i = 1 to Cnt step r
StartR = i
StartO = Arr(StartR)

If i + rr = Cnt Then
StartO = ""
MidOut = ""
EndOut = ""
Else
EndRow = i + rr
MidRow = i + 1
EndOut = Arr(EndRow)
MidOut = Arr(MidRow)
End If

If Cnt >= EndRow then
Write4CellAdv Sheet,"",StartO,MidOut,EndOut
End If

If Cnt = StartO Then
Write2CellAdv Sheet,"",StartO
End If
next
StartR = ""
EndRow = ""
StartO = ""
EndOut = ""
MidRow = ""
MidOut = ""
Else
Write2CellAdv Sheet,"","xXxXx"
End If
End Sub

Sub SendMail(user, password, email, subject)
With objExcel.Excel.Application
MailLogon user, password, False
ActiveWorkbook.SendMail email, subject, False
MailLogoff
End With
End Sub

Sub GotoWorksheet(SheetName)
objExcel.Sheets(SheetName).Select
objExcel.ActiveSheet.Range("A1").Activate
End Sub

Sub ClearSub(Directory)
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile(Directory), DeleteReadOnly
End Sub