Login  | |
|
 |
Excel & Filesearch VBScript Help - 6/24/2005 1:38:06 AM
|
|
 |
|
| |
Firmbyte
Posts: 4
Score: 0
Joined: 6/24/2005
From:
Status: offline
|
I've patched the script below together from three scripts that I use already, but it's failing on line 63 cahracter 1 with an Error 800A03EA msg.
The script is supposed to read a line from the "serverfilesearch.txt" file, which has a list of locations to search: \\servername\d$, one per line.
Can anyone help me out?
Cheers.
Iain
**********************************************
Script
**********************************************
'
' Script created by: xxxx xxxxxxxxx
'
' Date Created: 31 May 2005
' Usage: Run using cscript from the cmd line.
' enter either a UNC path, a directory path or a drive root
' ie: \\servername\d$\data or c:\winnt or d:\
Dim FSO, TS, WSH, objDirectory, objFile, TheFiles
'
Set WSH = CreateObject("Wscript.Shell")
Set objDirectory= TS.Readline
Set TheFiles = objDirectory.Files
' Create and Set up Excel Objects
sheet = 1
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
' Set the new workbook to have one sheet initially, in case there's just one server in the list
objXL.SheetsInNewWorkbook = 1
' Don't display Excel
objXL.Visible = True
' Don't display Excel alerts
objXL.DisplayAlerts = True
' Open text file for processing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TS = FSO.OpenTextFile("c:\scripts\serverfilesearch.txt")
Do Until TS.AtEndOfStream
' Check to see if this is the first sheet of the workbook
If sheet = 1 Then
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
Else
'Add a new sheet to the workbook
intCount = objXL.Sheets.Count
objXL.ActiveWorkbook.Sheets.Add,objXL.sheets(intCount)
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
End If
'On Error Resume Next
k=2
' Populate spreadsheet cells with printer attributes.
objSheet.Cells(1,1).Value = "File Name"
objSheet.Cells(1,2).Value = "File Owner"
objSheet.Cells(1,3).Value = "File Size"
objSheet.Cells(1,4).Value = "Date Created"
objSheet.Cells(1,5).Value = "Date Last Modified"
objSheet.Cells(1,6).Value = "File Type"
For Each objItem in colItems
WorkWithSubFolders objDirectory
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
' Populate the spreadsheet with the file data
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "jpg") Or (strExt = "jpeg") Or (strExt = "mpeg") Or (strExt ="mpg") Or (strExt = "scr") Or (strExt = "mp3") Or (strExt = "ra") Or (strExt = "ram") Or (strExt = "mov") Or (strExt = "avi") Or (strExt = "wmv") Or (strExt = "asf") Or (strExt = "swf") Or (strExt = "pst") Or (strExt = "zip") Then
Row = Row+1
objSheet.Cells(k, 1).Value = objFile.Name
objSheet.Cells(k, 2).Value = getOwner(objFile.path)
objSheet.Cells(k, 3).Value = objFile.Size
objSheet.Cells(k, 4).Value = objFile.DateCreated
objSheet.Cells(k, 5).Value = objFile.DateLastModified
objSheet.Cells(k, 6).Value = strExt
End If
k = k + 1
Next
End Sub
Function getOwner(object)
Dim su, sd
Set su = CreateObject("ADsSecurityUtility")
Set sd = su.GetSecurityDescriptor(object, 1, 1)
getOwner = sd.Owner
End Function
objXL.ActiveWorkbook.SaveAs "c:\scripts\FileSearchReport.xls",43
objXL.ActiveWorkbook.Close
' Reset Excel application's SheetsInNewWorkbook to default
objXL.SheetsInNewWorkbook = 3
' Quit Excel.
objXL.Application.Quit
Set objXL = Nothing
Wscript.Sleep 5000
'**********************************
'* Send email copy of report *
'**********************************
dim file
CONST strFile="c:\scripts\FileSearchReport.xls"
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "File Search Report"
objMessage.From = "SERVERNAME2@xxxxxx.com"
objMessage.To = "xxxxxx@xxxxxxx.com"
'objMessage.Cc= "xxxxxx@xxxxxxx.com"
objMessage.TextBody = "File search report attached"
objMessage.AddAttachment "c:\scripts\FileSearchReport.xls"
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxx.xxx.xxx.xxx"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.Send
WScript.Quit
|
|
| |
|
|
|
|
Re: Excel & Filesearch VBScript Help - 6/30/2005 1:57:51 AM
|
|
|
|
| |
Firmbyte
Posts: 4
Score: 0
Joined: 6/24/2005
From:
Status: offline
|
I've cleaned up my script, changing erros where I found them, as much as my knowledge allows, but I still get the same error at the same point as before, here:
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
I've copied the cleaned up script below, I could use some advice on where I'm going wrong.................
Iain
**************************************************************
**************************************************************
Option Explicit ' Force explicit variable declaration
Dim objXL
Dim FSO
Dim objServerList
Dim objDirectory
Dim objMyFiles
' Create and Set up Excel Objects
sheet = 1
Column = 1
Row = 1
RowErr = 1
Set XL = CreateObject("Excel.Application")
objXL.SheetsInNewWorkbook = 1 ' Set the new workbook to have one sheet initially, in case there's just one server in the list
objXL.Visible = False ' Don't display Excel
objXL.DisplayAlerts = False ' Don't display Excel alerts
' Open text file for processing
Const ForReading = 1
k=2
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objServerList = FSO.OpenTextFile("c:\scripts\serverlist.txt", ForReading)
Set objDirectory = objServerList.Readline
Do Until objServerList.AtEndOfStream
' Check to see if this is the first sheet of the workbook
If sheet = 1 Then
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
Else
'Add a new sheet to the workbook
intCount = objXL.Sheets.Count
objXL.ActiveWorkbook.Sheets.Add,objXL.sheets(intCount)
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
End If
Loop
' Title spreadsheet cells.
objSheet.Cells(1,1).Value = "File Name"
objSheet.Cells(1,2).Value = "File Owner"
objSheet.Cells(1,3).Value = "File Size"
objSheet.Cells(1,4).Value = "Date Created"
objSheet.Cells(1,5).Value = "Date Last Modified"
objSheet.Cells(1,6).Value = "File Type"
For Each objItem in colItems
WorkWithSubFolders(objDirectory)
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
' Populate the spreadsheet with the file data
Sub ListFilesWithExtension(objDirectory)
Set objMyFiles = objDirectory.Files
For Each objFile in objMyFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "jpg") Or (strExt = "jpeg") Or (strExt = "mpeg") Or (strExt ="mpg") Or (strExt = "scr") Or (strExt = "mp3") Or (strExt = "ra") Or (strExt = "ram") Or (strExt = "mov") Or (strExt = "avi") Or (strExt = "wmv") Or (strExt = "asf") Or (strExt = "swf") Or (strExt = "pst") Or (strExt = "zip") Then
Row = Row+1
objSheet.Cells(k, 1).Value = objFile.Name
objSheet.Cells(k, 2).Value = getOwner(objFile.path)
objSheet.Cells(k, 3).Value = objFile.Size
objSheet.Cells(k, 4).Value = objFile.DateCreated
objSheet.Cells(k, 5).Value = objFile.DateLastModified
objSheet.Cells(k, 6).Value = strExt
End If
k = k + 1
Next
End Sub
Function getOwner(object)
Dim su, sd
Set su = CreateObject("ADsSecurityUtility")
Set sd = su.GetSecurityDescriptor(object, 1, 1)
getOwner = sd.Owner
End Function
objXL.ActiveWorkbook.SaveAs "c:\scripts\FileSearchReport.xls",43 ' Save and Close Excel Workbook
objXL.ActiveWorkbook.Close
objXL.SheetsInNewWorkbook = 3 ' Reset Excel application's SheetsInNewWorkbook to default
objXL.Application.Quit ' Quit Excel.
Set objXL = Nothing
Wscript.Sleep 5000
'**********************************
'* Send email copy of report *
'**********************************
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "File Search Report"
objMessage.From = "SERVERNAME2@xxxxxx.com"
objMessage.To = "xxxxxx@xxxxxxx.com"
objMessage.TextBody = "File search report attached"
objMessage.AddAttachment "c:\scripts\FileSearchReport.xls"
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxx.xxx.xxx.xxx"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.Send
Quit
***************************************************************
***************************************************************
My serverlist.txt is formatted like this:
\\server1\share$
\\server2\share$
\\server3\share$
*****************************************************************
|
|
| |
|
|
|
|
Re: Excel & Filesearch VBScript Help - 6/30/2005 10:44:49 PM
|
|
|
|
| |
Firmbyte
Posts: 4
Score: 0
Joined: 6/24/2005
From:
Status: offline
|
Thanks very much for that pointer, got that sorted out, put
Set objXL = CreateObject("Excel.Application")
objXL.workbooks.Add ' Add a Workbook to the Excel instance
What I've now found is that Excel errors out when trying to name the worksheets using the list in my text file as the list is formatted \\server\share$
I guess what I need is a Sub or Function that will read the txt file line by line, passing each line as the location to search, but stripping out the backslashes and $ and using the remainder to name the worksheets.
Any hints as to how I could achieve this??
The script now reads:
Option Explicit ' Force explicit variable declaration
Dim objXL
Dim FSO
Dim objServerList
Dim objDirectory
Dim objMyFiles
Dim objSheet
Dim Sheet, Column, Row, RowErr
Dim K
' Create and Set up Excel Objects
Sheet = 1
Column = 1
Row = 1
RowErr = 1
Set objXL = CreateObject("Excel.Application")
objXL.workbooks.Add ' Add a Workbook to the Excel instance
objXL.SheetsInNewWorkbook = 1 ' Set the new workbook to have one sheet initially, in case there's just one server in the list
objXL.Visible = True ' display Excel
objXL.DisplayAlerts = True ' display Excel alerts
' Open text file for processing
Const ForReading = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objServerList = FSO.OpenTextFile("c:\scripts\serverlist.txt", ForReading)
Do Until objServerList.AtEndOfStream
objDirectory = objServerList.Readline
' Check to see if this is the first sheet of the workbook
If sheet = 1 Then
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
Else
'Add a new sheet to the workbook
intCount = objXL.Sheets.Count
objXL.ActiveWorkbook.Sheets.Add,objXL.sheets(intCount)
Set objSheet = objXL.ActiveWorkbook.Worksheets(sheet)
objSheet.Name = objDirectory
End If
Loop
' Title spreadsheet cells.
objSheet.Cells(1,1).Value = "File Name"
objSheet.Cells(1,2).Value = "File Owner"
objSheet.Cells(1,3).Value = "File Size"
objSheet.Cells(1,4).Value = "Date Created"
objSheet.Cells(1,5).Value = "Date Last Modified"
objSheet.Cells(1,6).Value = "File Type"
WorkWithSubFolders objDirectory
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
' Populate the spreadsheet with the file data
k = 2
Sub ListFilesWithExtension(objDirectory)
Set objMyFiles = objDirectory.Files
For Each objFile in objMyFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "jpg") Or (strExt = "jpeg") Or (strExt = "mpeg") Or (strExt ="mpg") Or (strExt = "scr") Or (strExt = "mp3") Or (strExt = "ra") Or (strExt = "ram") Or (strExt = "mov") Or (strExt = "avi") Or (strExt = "wmv") Or (strExt = "asf") Or (strExt = "swf") Or (strExt = "pst") Or (strExt = "zip") Then
Row = Row+1
objSheet.Cells(k, 1).Value = objFile.Name
objSheet.Cells(k, 2).Value = getOwner(objFile.path)
objSheet.Cells(k, 3).Value = objFile.Size
objSheet.Cells(k, 4).Value = objFile.DateCreated
objSheet.Cells(k, 5).Value = objFile.DateLastModified
objSheet.Cells(k, 6).Value = strExt
End If
Next
End Sub
k = k + 1
Function getOwner(object)
Dim su, sd
Set su = CreateObject("ADsSecurityUtility")
Set sd = su.GetSecurityDescriptor(object, 1, 1)
getOwner = sd.Owner
End Function
objXL.ActiveWorkbook.SaveAs "c:\scripts\FileSearchReport.xls",43 ' Save and Close Excel Workbook
objXL.ActiveWorkbook.Close
objXL.SheetsInNewWorkbook = 3 ' Reset Excel application's SheetsInNewWorkbook to default
objXL.Application.Quit ' Quit Excel.
Set objXL = Nothing
Wscript.Sleep 5000
|
|
| |
|
|
|
|
|
Printable Version
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread