consolidate duplicates with vbs

mipszzz

New Member
Joined
May 27, 2009
Messages
12
I have a fantastic VB Script that I found on the web sometime ago. It searches a predetermined list of Windows computers for WMI attributes. It then outputs this list to Excel.

I am no coder but I was able to customize the script to some degree to add additional info. One of the classes I have added was to list features that the server offers. Doing this causes the spreadsheet to add a line for each feature for each server. Generally each server has 10 to 20 features. Therefore for a list of 20 servers, rather than a list of 20 lines, I get a line for each feature for each server. Makes for a very lengthy spreadsheet.

This is an example output for a single server. Multiple this by 20 or 30 for the number of servers.
[TABLE="width: 533"]
<tbody>[TR]
[TD]

[TABLE="class: grid, width: 533"]
<tbody>[TR]
[TD]
[/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]HostName
[/TD]
[TD]Feature Name
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Services
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy and Access Services
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1 Features
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Services
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD]ServerName
[/TD]
[TD]Remote Server Administration Tools
[/TD]
[/TR]
[TR]
[TD]9
[/TD]
[TD]ServerName
[/TD]
[TD]Group Policy Management
[/TD]
[/TR]
[TR]
[TD]10
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Domain Controller
[/TD]
[/TR]
[TR]
[TD]11
[/TD]
[TD]ServerName
[/TD]
[TD]Network Policy Server
[/TD]
[/TR]
[TR]
[TD]12
[/TD]
[TD]ServerName
[/TD]
[TD].NET Framework 3.5.1
[/TD]
[/TR]
[TR]
[TD]13
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP Service
[/TD]
[/TR]
[TR]
[TD]14
[/TD]
[TD]ServerName
[/TD]
[TD]SNMP WMI Provider
[/TD]
[/TR]
[TR]
[TD]15
[/TD]
[TD]ServerName
[/TD]
[TD]Role Administration Tools
[/TD]
[/TR]
[TR]
[TD]16
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Tools
[/TD]
[/TR]
[TR]
[TD]17
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Certificate Services Tools
[/TD]
[/TR]
[TR]
[TD]18
[/TD]
[TD]ServerName
[/TD]
[TD]DNS Server Tools
[/TD]
[/TR]
[TR]
[TD]19
[/TD]
[TD]ServerName
[/TD]
[TD]Certification Authority Tools
[/TD]
[/TR]
[TR]
[TD]20
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS Snap-Ins and Command-Line Tools
[/TD]
[/TR]
[TR]
[TD]21
[/TD]
[TD]ServerName
[/TD]
[TD]DHCP Server Tools
[/TD]
[/TR]
[TR]
[TD]22
[/TD]
[TD]ServerName
[/TD]
[TD]AD DS and AD LDS Tools
[/TD]
[/TR]
[TR]
[TD]23
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory Administrative Center
[/TD]
[/TR]
[TR]
[TD]24
[/TD]
[TD]ServerName
[/TD]
[TD]Active Directory module for Windows PowerShell
[/TD]
[/TR]
</tbody>[/TABLE]


[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I found a macro that I can run inside Excel that worked great.

Sub olio()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Range("B2:B" & lr)
c.Value = c.Value & "(" & c.Offset(0, 1).Value & ")"
Next
For i = lr To 3 Step -1
With sh
If .Cells(i, 1) = .Cells(i - 1, 1) Then
If .Cells(i - 1, 2).Value <> .Cells(i, 2).Value Then
.Cells(i - 1, 2) = .Cells(i - 1, 2).Value & ", " & .Cells(i, 2).Value
.Cells(i - 1, 3) = .Cells(i - 1, 3).Value & ", " & .Cells(i, 3).Value
End If
Rows(i).Delete
End If
End With
Next
End Sub

But I failed to add it to the VBScript that I am running to gather all the info so it happens in one shot. Any insight into how I can add it into the main script would be greatly appreciated.


Below is the VBScript that I am working with.

[TABLE="width: 500"]
<tbody>[TR]
[TD]'**********************************************
'**********************************************
'Date: 04/17/2006
'Title: SMS-PC-Inventory.vbs
'Version: 1.09
'Authors: Clark Caldwell/Alex Angelopoulos/Torgeir Bakken
'Testers: Trey Shaver
'Use: Create network computer inventory in an Excel Spreadsheet.
'Comments:
'Must have ADSI and WMI installed on PC running script.
'
'Must have Excel!
'
'Must have Admin rights on machines you connect to.
'
'If a computer cannot be contacted then it will write that IP to
'PC_Inv_NA.txt outputfile.
'
'Windows XP SP 2 firewall will block this script, enable file/print
'sharing manualy or through a GPO.
'
'Must create the PC_Inv_IP.txt file with the provided script or
'manualy with IP addresses.
'
'Email ccaldwell@dblair.com with problems/sugestions.
'
'***********************************************
'***** DECLARATIONS*****************************
CONST ForReading = 1
CONST ForWriting = 2
CONST DEV_ID = 0
CONST FSYS = 1
CONST DSIZE = 2
CONST FSPACE = 3
CONST USPACE = 4
CONST Feat_ID = 5
CONST Feat_Name = 6

CONST TITLE = "SMS-PC-Inventory"

Dim fso, f, fsox, fx, objXL, wmiPath, strNoPing, strMBProduct
Dim computerIndex, wscr, adsi, intbutton, strStart, Cshell, strNoConnect
Dim inputFile, outputFile, objKill, strAction, strComplete, strManufact
Dim strPC, intRow, strFilter, RowNum, strCompName, strVideo, strFSB
Dim strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strSD
Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic, strUser
Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed, strHostName
Dim pathlength, Scriptpath, objIEScan, strSN, strOSarch, strRAM2, strFeat_ID, strFeat_Name

'Get Script Location
pathlength = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathlength)

set adsi = CreateObject("ADSystemInfo")
set wscr = CreateObject("WScript.Network")

inputFile = "PC_Inv_IP.txt" 'List of IP's to scan.
outputFile = "PC_Inv_NA.txt" 'List of IP's that couldn't be scanned.

Call KillFile()

set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(inputFile, ForReading, True)
set fsox = CreateObject("Scripting.FileSystemObject")
set fx = fsox.OpenTextFile(outputFile, ForWriting, True)
Set Cshell = CreateObject("WScript.Shell")
computerIndex = 1

'*****[ FUNCTIONS ]*******************************

Function Ask(strAction)
intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE)
Ask = intButton = vbNo
End Function

'*****[ MAIN SCRIPT ]*****************************

If Ask("Run Network Inventory?") Then
Wscript.Quit
Else
strStart = "Inventory run started: " & Date & " at " & time
End If

Call BuildXLS()
Call Connect()
'Call Footer()

objIEScan.Quit

'objXL.ActiveWorkbook.SaveAs Scriptpath & "SMS-Network-Inventory.xls":
'MsgBox "Your inventory run has completed!", vbInformation + vbOKOnly, TITLE

'*****[ SUB ROUTINES ]****************************

'*** Subroutine Connect ***

Sub Connect()

Do While f.AtEndOfLine <> True
strPC = f.ReadLine
If strPC <> "" Then
If Not IsConnectible(strpc, "", "") Then

strNoPing = "Couldn't ping " & strPC
Call MsgNoPing()
Call Error()
Else
On Error Resume Next
set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2")

If Err.Number <> 0 Then

strNoConnect = "Couldn't connect to " & strPC
Call MsgNoConnect()
Call Error()
Else

strCompName = UCase(strPC)

' set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_SystemEnclosure")
set SNSet = oWMI.ExecQuery("select SerialNumber from Win32_BIOS")
for each SN in SNSet
strSN = SN.SerialNumber
If strSN = "" Then
strMask = "Blank"
Else
End If
Next

set SDSet = oWMI.ExecQuery("select SocketDesignation from Win32_Processor")
for each SD in SDSet
strSD = SD.SocketDesignation
Next

set MemorySet = oWMI.ExecQuery("select TotalPhysicalMemory, " & "TotalVirtualMemory, TotalPageFileSpace from " & "Win32_LogicalMemoryConfiguration")
for each Memory in MemorySet
strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mb"
strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mb"
strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mb"
Next
'
' set IPAddress = oWMI.ExecQuery("select IPAddress from Win32_NetworkAdapter")
' for each IP in IPAddress
' strIP = IP.IPAddress
'
' Next

set OSSet = oWMI.ExecQuery("select Caption, CSDVersion, SerialNumber, TotalVisibleMemorySize " & "from Win32_OperatingSystem")
for each OS in OSSet
strOS = OS.Caption
strSP = OS.CSDVersion
strProdID = OS.SerialNumber
strRAM2 = FormatNumber(OS.TotalVisibleMemorySize/1048576,1) & " GB"
Next

set IPConfigSet = oWMI.ExecQuery("select ServiceName, IPAddress, " & "IPSubnet, DefaultIPGateway, MACAddress from " & "Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
Count = 0
for each IPConfig in IPConfigSet
Count = Count + 1
Next
ReDim sName(Count - 1)
ReDim sIP(Count - 1)
ReDim sMask(Count - 1)
ReDim sGate(Count - 1)
ReDim sMAC(Count - 1)
Count = 0
for each IPConfig in IPConfigSet
sName(Count) = IPConfig.ServiceName(0)
strNIC = sName(Count)
sIP(Count) = IPConfig.IPAddress(0)
strIP = sIP(Count)
sMask(Count) = IPConfig.IPSubnet(0)
strMask = sMask(Count)
sGate(Count) = IPConfig.DefaultIPGateway(0)
strGate = sGate(Count)
sMAC(Count) = IPConfig.MACAddress(0)
strMAC = sMAC(Count)
Count = Count + 1
If strMask = "" Then
strMask = "Blank"
Else
End If
If strGate = "" Then
strGate = "Blank"
Else
End If
Next

set ProSet = oWMI.ExecQuery("select Name, MaxClockSpeed from Win32_Processor")
for each Pro in ProSet
strProc = Pro.Name
strSpeed = Pro.MaxClockSpeed & " Hz"
Next

set HostName = oWMI.ExecQuery("select DNSHostName from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
for each Host in HostName
strHostName = Host.DNSHostName

Next

set VideoMem = oWMI.ExecQuery("select AdapterRAM from Win32_VideoController")
for each Video in VideoMem
strVideo = FormatNumber(Video.AdapterRAM/2^20,1) & " Mb"

Next

set loggeduser = oWMI.ExecQuery("select UserName from Win32_ComputerSystem")
for each logged in loggeduser
struser = logged.UserName

Next

set FSBSpeed = oWMI.ExecQuery("select ExtClock from Win32_Processor")
for each FSB in FSBSpeed
strFSB = FSB.ExtClock & " Mhz"

Next


set Manufact = oWMI.ExecQuery("select Manufacturer from Win32_BIOS")
for each Man in Manufact
strManufact = Man.Manufacturer

Next

set MBProduct = oWMI.ExecQuery("select Model, SystemType " & "from Win32_ComputerSystem")

for each MBP in MBProduct
strMBProduct = MBP.Model
strOSarch = MBP.SystemType



Next

' set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where DeviceID = 'C:'")
set DiskSet = oWMI.ExecQuery("select DeviceID, FileSystem, Size, FreeSpace " & "from Win32_LogicalDisk where DriveType = '3'")
ReDim strDisk(RowNum,4)

for each Disk in DiskSet

strDisk(RowNum,DEV_ID)= Disk.DeviceID
strDisk(RowNum,FSYS)= Disk.FileSystem
strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gb"
strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gb"
strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gb"

Next

set FeatureSet = oWMI.ExecQuery("select ID, Name " & "from Win32_ServerFeature")
ReDim strFeature(RowNum,6)

for each Feature in FeatureSet

strFeature(RowNum,Feat_ID)= Feature.ID
strFeature(RowNum,Feat_Name)= Feature.Name


' Call AddLineToXLS(strCompName, strHostName, strSN, strOS, strSP, strProdID, strSpeed, strMBProduct, strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strUser,)
' Call AddLineToXLS(strCompName, strHostName, strSN, strManufact, strMBProduct, strOS, strSP, strProc, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strIP, strMask, strGate, strMAC, strRAM2, strOSarch, strFeature(RowNum,Feat_ID), strFeature(RowNum,Feat_Name))
Call AddLineToXLS(strHostName, strFeature(RowNum,Feat_Name), strOS, strSP, strIP, strRAM2, strOSarch, strFeature(RowNum,Feat_ID))

Next

End If
End If
End If
Loop

End Sub


'*** Subroutine Build XLS ***

Sub BuildXLS()

intRow = 1
Set objXL = Wscript.CreateObject("Excel.Application")
objXL.Visible = True
objXL.WorkBooks.Add
objXL.Sheets("Sheet1").Select()
objXL.Sheets("Sheet1").Name = "Server Features"


'** Set Row Height
objXL.Rows(1).RowHeight = 25

'** Set Column widths
objXL.Columns(1).ColumnWidth = 25
objXL.Columns(2).ColumnWidth = 50
objXL.Columns(3).ColumnWidth = 50
objXL.Columns(4).ColumnWidth = 25
objXL.Columns(5).ColumnWidth = 18
objXL.Columns(6).ColumnWidth = 12
objXL.Columns(7).ColumnWidth = 25
objXL.Columns(8).ColumnWidth = 15
objXL.Columns(9).ColumnWidth = 9
objXL.Columns(10).ColumnWidth = 11
objXL.Columns(11).ColumnWidth = 9
objXL.Columns(12).ColumnWidth = 11
objXL.Columns(13).ColumnWidth = 11
objXL.Columns(14).ColumnWidth = 15
objXL.Columns(15).ColumnWidth = 14
objXL.Columns(16).ColumnWidth = 17
objXL.Columns(17).ColumnWidth = 18
objXL.Columns(18).ColumnWidth = 15
objXL.Columns(19).ColumnWidth = 16




'*** Set Cell Format for Column Titles ***

objXL.Range("A1:H1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 12
objXL.Selection.Interior.ColorIndex = 11
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2
objXL.Selection.WrapText = True
objXL.Columns("A:S").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter

'*** Set Column Titles ***

'Call AddLineToXLS ("1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19")
Call AddLineToXLS("HostName","Feature Name","Operating System","Service Pack","IP Address","Memory","OS Architecture","Feature ID")

Set objIESmoke = WScript.CreateObject("InternetExplorer.Application")
objIESmoke.Navigate("about:blank")
objIESmoke.ToolBar = 0
objIESmoke.StatusBar = 0
objIESmoke.Width= 200
objIESmoke.Height = 100
objIESmoke.Left = 400
objIESmoke.Top = 400
Set objDoc = objIESmoke.Document.Body
strHTML = "Smoke'm if you Got'em"
objDoc.InnerHTML = strHTML
objIESmoke.Visible = True
WScript.Sleep 2800
objIESmoke.Quit

Set objIEScan = WScript.CreateObject("InternetExplorer.Application")
objIEScan.Navigate("about:blank")
objIEScan.ToolBar = 0
objIEScan.StatusBar = 0
objIEScan.Width = 200
objIEScan.Height = 100
objIEScan.Left = 400
objIEScan.Top = 400
Set objDoc = objIEScan.Document.Body
strHTML = "Scanning..."
objDoc.InnerHTML = strHTML
objIEScan.Visible = True

End Sub

'*** Subroutine Add Lines to XLS ***

objXL.Columns("A:H").Select
objXL.Selection.HorizontalAlignment = 3 'xlCenter
objXL.Selection.Font.Size = 12

Sub AddLineToXLS(strHostName, strFeat_Name, strOS, strSP, strIP, strRAM2, strOSarch, strFeat_ID)

' objXL.Cells(intRow, 1).Value = strCompName
objXL.Cells(intRow, 1).Value = strHostName
' objXL.Cells(intRow, 2).Value = strSN
' objXL.Cells(intRow, 3).Value = strManufact
objXL.Cells(intRow, 2).Value = strFeat_Name
' objXL.Cells(intRow, 3).Value = strMBProduct
objXL.Cells(intRow, 3).Value = strOS
objXL.Cells(intRow, 4).Value = strSP
' objXL.Cells(intRow, 4).Value = strProc
' objXL.Cells(intRow, 5).Value = strDEV_ID
' objXL.Cells(intRow, 6).Value = strFSYS
' objXL.Cells(intRow, 7).Value = strDSIZE
objXL.Cells(intRow, 5).Value = strIP
' objXL.Cells(intRow, 8).Value = strMask
' objXL.Cells(intRow, 9).Value = strGate
' objXL.Cells(intRow, 10).Value = strMAC
objXL.Cells(intRow, 6).Value = strRAM2
objXL.Cells(intRow, 7).Value = strOSarch
objXL.Cells(intRow, 8).Value = strFeat_ID



intRow = intRow + 1
objXL.Cells(1, 1).Select
End Sub

'*** Subroutine Add Lines to XLS for Disk Info. ***

'Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE)

' objXL.Cells(intRow, 8).Value = strDEV_ID
' objXL.Cells(intRow, 9).Value = strFSYS
' objXL.Cells(intRow, 10).Value = strDSIZE
' objXL.Cells(intRow, 11).Value = strFeat_ID
' objXL.Cells(intRow, 12).Value = strFeat_Name

' intRow = intRow + 1
' objXL.Cells(1, 1).Select
'End Sub

'*** Delete file if exists ***

Sub KillFile()

Set objKill = CreateObject("Scripting.FileSystemObject")
If (objKill.FileExists("PC_Inv_NA.txt")) Then
objKill.DeleteFile("PC_Inv_NA.txt")
End If
Set objKill = Nothing
End Sub

'*** Sub to add footer when speadsheet is complete ***

Sub Footer()

strFooter2 = "Script Modified by Mits Matsu****a for Hardware Inventory"
strComplete = "Inventory run completed at: " & Date & " at " & time

intRow = intRow + 2

'** Set Cell Format for Row

objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strFooter2

intRow = intRow + 1

'** Set Cell Format for Row

objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strStart

intRow = intRow + 1

'** Set Cell Format for Row

objXL.Cells(intRow, 2).Select
objXL.Selection.Font.ColorIndex = 1
objXL.Selection.Font.Size = 8
objXL.Selection.Font.Bold = False
objXL.Selection.HorizontalAlignment = 2 'xlRight
objXL.Cells(intRow, 2).Value = strComplete

intRow = intRow + 1


End Sub


'*** ErrorHandler ***

Sub Error()

fx.WriteLine(strPC)

End Sub

'*** Ping Host Timeout ***

Function IsConnectible(sHost, iPings, iTO)
' Returns True or False based on the output from ping.exe
'
' Author: Alex Angelopoulos/Torgeir Bakken
' Works an "all" WSH versions
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used


Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim oShell, oFSO, sTempFile, fFile

If iPings = "" Then iPings = 2
If iTO = "" Then iTO = 750

Set oShell = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

sTempFile = oFSO.GetSpecialFolder(2).ShortPath & "\" & oFSO.GetTempName

oShell.Run "%comspec% /c ping.exe -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)

Select Case InStr(fFile.ReadAll, "TTL=")
Case 0 IsConnectible = False
Case Else IsConnectible = True
End Select

fFile.Close
oFSO.DeleteFile(sTempFile)

End Function

Sub MsgNoPing()

Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.ToolBar = 0
objIE.StatusBar = 0
objIE.Width= 200
objIE.Height = 100
objIE.Left = 400
objIE.Top = 400
Set objDoc = objIE.Document.Body
strHTML = strNoPing
objDoc.InnerHTML = strHTML
objIE.Visible = True
WScript.Sleep 2500
objIE.Quit

End Sub

Sub MsgNoConnect()

Set objIE2 = WScript.CreateObject("InternetExplorer.Application")
objIE2.Navigate("about:blank")
objIE2.ToolBar = 0
objIE2.StatusBar = 0
objIE2.Width= 200
objIE2.Height = 100
objIE2.Left = 400
objIE2.Top = 400
Set objDoc = objIE2.Document.Body
strHTML = strNoConnect
objDoc.InnerHTML = strHTML
objIE2.Visible = True
WScript.Sleep 2500
objIE2.Quit

End Sub




[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top