Re: VBScript and MSOffice by McKirahan
McKirahan
Mon Aug 14 18:55:23 CDT 2006
"SrChasJC" <SrChasJC@discussions.microsoft.com> wrote in message
news:2D0CC9F1-36AA-4C30-9BAE-A7775C649264@microsoft.com...
> Is it possible to harvest all the fieldnames and 1st line of data from all
> xls and mdb's using vbscript? The reason is to verify a company computer
does
> not have SSN's or bank account or checking account files, or cc numbers on
> it. A policy might be in place but to actually audit hundreds of machines
> would take months, and by then I would need to audit again! To find all
the
> files is easy, but to make things simple I would want to gleam all the
data
> into a csv file with the machine name, filename and path in case you found
> one you would know where it came from. Is this out of the range of
reasonable
> for vbscript?
Here's a script that will process a list of MS-Excel workbooks.
It will generate a Tab Separated Variable file with a header row of:
Workbook Worksheet Column
which can be opened up in MS-Excel for analysis
(via Data + Get External Data + Import Text File...).
Watch for word.wrap.
Option Explicit
'*
'* Declare Constants
'*
Const cVBS = "Workbook.vbs"
Const cTXT = "Workbook.txt"
Const cCSV = "Workbook.csv"
'*
'* Declare Variables
'*
Dim intAWW
Dim strAWW
Dim intCOL
Dim strCOL
Dim intFOR
Dim intINS
Dim intMAX
Dim strOTF
Dim intROW
Dim intTOT(2)
intTOT(0) = 0
intTOT(1) = 0
intTOT(2) = 0
Dim strTOT
strTOT = "# Workbooks; ## Worksheets; ### Columns"
Dim strWOR
Dim arrXLS
Dim intXLS
Dim strXLS
'*
'* Declare Objects
'*
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOTF
Dim objAWW
Dim objXLA
'*
'* Read list of databases
'*
Set objOTF = objFSO.OpenTextFile(cTXT,1)
strOTF = objOTF.ReadAll
Set objOTF = Nothing
'*
'* Databases, Tables, and Columns
'*
Set objOTF = objFSO.OpenTextFile(cCSV,2,True)
objOTF.WriteLine("Workbook" & vbTab & "Worksheet" & vbTab &
"Column")
arrXLS = Split(strOTF,vbCrLf)
For intXLS = 0 To UBound(arrXLS)
strXLS = arrXLS(intXLS)
If InStr(LCase(strXLS),".xls") > 0 Then
intINS = InStr(strXLS,":")
If intINS > 0 Then strXLS = Mid(strXLS,intINS-1)
intTOT(0) = intTOT(0) + 1
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = False
objXLA.Workbooks.Open strXLS,False,True
For intAWW = 1 To objXLA.Worksheets.Count
intTOT(1) = intTOT(1) + 1
Set objAWW = objXLA.ActiveWorkbook.Worksheets(intAWW)
strAWW = intAWW & "=" & objAWW.Name
intMAX = objAWW.UsedRange.Columns.Count
intROW = objAWW.UsedRange.Row
For intFOR = 0 to intMAX-1
intCOL = intFOR + objAWW.UsedRange.Column
strCOL = objAWW.Cells(intROW,intCOL).Value
objOTF.WriteLine(strXLS & vbTab & strAWW & vbTab &
strCOL)
intTOT(2) = intTOT(2) + 1
Next
Set objAWW = Nothing
Next
objXLA.Application.DisplayAlerts = False
objXLA.Quit
Set objXLA = Nothing
End If
Next
Set objOTF = Nothing
'*
'* Destroy Objects
'*
Set objFSO = Nothing
'*
'* Finish
'*
strTOT = Replace(strTOT,"###",FormatNumber(intTOT(2),0))
strTOT = Replace(strTOT,"##",FormatNumber(intTOT(1),0))
strTOT = Replace(strTOT,"#",FormatNumber(intTOT(0),0))
MsgBox strTOT,vbInformation,cVBS
The input file ("Workbook.txt") can be generated via the MS-DOS
command "attrib". To identify all MS-Excel workbooks on a drive:
run the following form a Command prompt:
attrib \*.xls /s > Workbook.txt