I'm trying to create an HTA To Do List saving locally to a text file. Every time you press submit button generates a new entry that display inside hta body and it's being saved inside the text file. I want to develop this furthermore :
delete an entry and update body/text file
modify an entry and update body/text file
put new entry on top
Any suggestions?
<html>
<head>
<HTA:APPLICATION SINGLEINSTANCE="yes" APPLICATIONNAME="To Do List">
</head>
<SCRIPT Language="VBScript">
Sub Window_OnLoad
ReadBlog
End Sub
Sub SaveData
strDel1="<"
strDel2=">"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("C:\Test.txt") Then
Set objFile = objFSO.OpenTextFile("C:\Test.txt", 8)
strLine = strDel1 & Time & vbTab & Date & vbTab & Title.Value & vbTab & Message.Value & strDel2
objFile.WriteLine strLine
objFile.Close
Else
Set objFile = objFSO.CreateTextFile("C:\Test.txt")
strLine = strDel1 & Time & vbTab & Date & vbTab & Title.Value & vbTab & Message.Value & strDel2
objFile.WriteLine strLine
objFile.Close
End If
ReadBlog
ClearText
End Sub
Sub ReadBlog
Const ForReading = 1, ForWriting = 2
dim sampletext, objRegExp, SearchPattern, ReplacePattern, matches
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Test.txt", ForReading)
Do Until objFile.AtEndOfStream
sampletext = objFile.ReadAll
SearchPattern = "<"
SearchPattern = SearchPattern & "(.*?)([\s\S]*?)"
SearchPattern = SearchPattern & ">"
Set objRegExp = New RegExp
objRegExp.Pattern = searchpattern ' apply the search pattern
objRegExp.Global = True ' match all instances if the serach pattern
objRegExp.IgnoreCase = True ' ignore case
Set matches = objRegExp.execute(sampletext)
If matches.Count > 0 Then ' there was at least one match to the search pattern
i=0
For Each match in matches
arrEntry = Split(Split(match.Value, "<")(1), ">")(0)
arrFields = Split(arrEntry, vbTab)
strTime = arrFields(0)
strDate = arrFields(1)
strTitle = arrFields(2)
strMessage = arrFields(3)
strHTML = strHTML & "<p>" & strTime & "</p>"
strHTML = strHTML & "<p>" & strDate & "</p>"
strHTML = strHTML & "<p>" & strTitle & "</p>"
strHTML = strHTML & "<p>" & strMessage & "</p>"
strHTML = strHTML & "<input type='button' name='Delete' value='Delete' >"& i &"<p>"
i=i+1
Next
Else ' there were no matches found
MsgBox objRegExp.Pattern & "was not found in the string"
End If
Loop
DataArea.InnerHTML = strHTML
Set objRegExp = Nothing
Set objFSO = Nothing
End Sub
Sub ClearText
Title.Value = ""
Message.Value = ""
End Sub
</SCRIPT>
<body>
<input type="text" name="Title" size="101"><p>
<textarea rows="10" cols="76" type="text" name="Message" size="25"></textarea><p>
<input type="button" value="Submit" onClick="SaveData">
<p><div id="DataArea"></div></p>
</body>
</html>
Are you particularly tied to using text files? If you used a database (such as access) you could do this quite easily (you don't have to have access installed to use an access database with an HTA either). And it would open up some other possibilities.
Incidentally, I also notice you're doing this:
strHTML = strHTML & "<p>" & strTime & "</p>"
strHTML = strHTML & "<p>" & strDate & "</p>"
strHTML = strHTML & "<p>" & strTitle & "</p>"
strHTML = strHTML & "<p>" & strMessage & "</p>"
Not a big thing, but concatenating the strings like that isn't great for performance. You'd be better off writing it all to the variable at the same time, otherwise it has to keep writing the variable to memory over and over again.
If you want to read a file with HTA you can easily do it in javaScript. Since the context changes IE allws you to directly read file on the computer or the network to wich the computer is linked to. In order to do so, you need to access the File System Object (FSO)
Full Documentation on FSO
If you are still looking to access a database you need to use the ADODB.Connection. That will allow you to connect to database localy or remotely. Altought there is not much documentation on the subject we did it at my work place. With a little imagination you can figure out how to fix it.
Documentation on the ADODB.Connnect
In this documentation the example are in VB but you can write them in JS as well.
Related
Good morning all,
I have been trying to pull together a VBscript that takes a file path and a file name (that may have a wildcard in it) from the user when the script is exicuted. The script will then check the specified directory for a file that matches the provided file name and then looks at the last modified date to see if it was created/modified within a certain time frame (i.e. 6am plus or minus 5 minutes). It would then copy said file into a zip file.
So far I have been able to get the arguments working, and I have it setup to grab the current time, look at the files in the folder and match a hard coded filename to one in the folder. This is what I have thus far.
currentTime = Now()
filePath = Wscript.Arguments.Item(0)
fileName = Wscript.Arguments.Item(1)
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set directory = fileSystem.GetFolder(filePath)
For each file in directory.Files
If file.Name = fileName Then
Wscript.echo file.Name & " " & file.DateLastModified
end if
Next
I am a VBscript noob and I am looking forward to learning the way!
Cap3
If you use WMI, it supports wildcards.
Dim strPath
strFile = "*.*"
If WScript.Arguments.Count > 1 Then
strPath = WScript.Arguments.Item(0)
strFile = WScript.Arguments.Item(1)
Elseif WScript.Arguments.Count = 1 Then
strPath = WScript.Arguments.Item(0)
Else
End If
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strPath) Then
WScript.Echo "Folder path does not exist."
WScript.Quit
Else
'Remove any trailing slash
If Right(strPath, 1) = "\" Then
strPath = Left(strPath, Len(strPath) - 1)
End If
End If
Set objFso = Nothing
If Not IsNull(strPath) And strPath <> "" Then
strQuery = strPath & "\" & strFile
Else
strQuery = strFile
End If
strQuery = Replace(strQuery, "*", "%")
strQuery = Replace(strQuery, "?", "_")
strQuery = Replace(strQuery, "\", "\\")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("Select * From CIM_DataFile Where FileName Like '" & strQuery & "'")
For Each objFile in colFiles
WScript.Echo "Access mask: " & objFile.AccessMask
WScript.Echo "Archive: " & objFile.Archive
WScript.Echo "Compressed: " & objFile.Compressed
WScript.Echo "Compression method: " & objFile.CompressionMethod
WScript.Echo "Creation date: " & objFile.CreationDate
WScript.Echo "Computer system name: " & objFile.CSName
WScript.Echo "Drive: " & objFile.Drive
WScript.Echo "8.3 file name: " & objFile.EightDotThreeFileName
WScript.Echo "Encrypted: " & objFile.Encrypted
WScript.Echo "Encryption method: " & objFile.EncryptionMethod
WScript.Echo "Extension: " & objFile.Extension
WScript.Echo "File name: " & objFile.FileName
WScript.Echo "File size: " & objFile.FileSize
WScript.Echo "File type: " & objFile.FileType
WScript.Echo "File system name: " & objFile.FSName
WScript.Echo "Hidden: " & objFile.Hidden
WScript.Echo "Last accessed: " & objFile.LastAccessed
WScript.Echo "Last modified: " & objFile.LastModified
WScript.Echo "Manufacturer: " & objFile.Manufacturer
WScript.Echo "Name: " & objFile.Name
WScript.Echo "Path: " & objFile.Path
WScript.Echo "Readable: " & objFile.Readable
WScript.Echo "System: " & objFile.System
WScript.Echo "Version: " & objFile.Version
WScript.Echo "Writeable: " & objFile.Writeable
Next
EDIT..........
You can use a WMI event script with the __InstanceCreationEvent to monitor for new file creation in a specific folder. It looks like this:
strSource = "C:\\somefilepath\\withdoubleshlashes"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & strComputer & "rootcimv2")
Set colEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 10 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' AND " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSource & """'")
Do While True
Set objEvent = colEvents.NextEvent()
copyFile(objEvent.TargetInstance.PartComponent)
Loop
For a full explanation, you can read Monitoring and Archiving Newly Created Files on my blog.
This answer uses Regular Expressions. To make it work it rewrites your pattern format into regular expression format. e.g. *.txt will become ^.*[.]txt$.
The following lists text files in C:\Temp last modified between 5:55 AM and 6:05 AM:
strPath = "C:\Temp"
strFile = "*.txt"
startTime = 555
endTime = 605
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strPath)
Set files = folder.Files
Set re = New RegExp
re.IgnoreCase = true
re.Pattern = "^" + Replace(Replace(strFile, ".", "[.]"), "*", ".*") + "$"
For Each f in Files
Set matches = re.Execute(f.Name)
If matches.Count > 0 Then
HM = Hour(f.DateLastAccessed) * 100 + Minute(f.DateLastAccessed)
If HM >= startTime And HM <= endTime Then
WScript.Echo f.Name, f.DateLastAccessed
End If
End If
Next
References:
Regular Expression (RegExp) Object
Regular Expressions and Operators
Microsoft Beefs Up VBScript with Regular Expressions
Hey, Scripting Guy! Raising Eyebrows on Regular Expressions
For your example, the easiest way to do this is to use the inStr (In String)function. I find it works in 99% of my wild card tasks. So, in your example, instead of using:
If file.Name = fileName Then
use:
If inStr(file.Name, filename) Then
This doesn't actually allow for wildcards(*) as it won't find a match(with the asterisk in the argument), so you would need to strip the wildcard from the string and replace it with nothing (or just train the user to not use wildcards):
Replace(filename,"*", "")
However, the inStr function does allow for partial or full matches which makes it suitable for most wildcard tasks. Therefore, if your file name is pic.jpg, whether the user searches for:
pic or jpg or p or c or pi etc.
It will return a match. Keep in mind though, that the instr function returns a number where the match shows up in the string. So, if it doesn't create a match, the result will be 0. I've run into examples where NOT doesn't work or I've needed to use the full syntax which in this case would be:
If inStr(file.Name, filename)<>0 Then
My Hta add bookmark using vbscript. when user type Web address like http://www.Google.com/ it works well but when user type www.Google.com only,it add a button but this time button doesn't work and ended up showing an error of invalid address. code --
<HTML xmlns:IE>
<HEAD>
<TITLE>Bookmarks</TITLE>
<HTA:APPLICATION
ID="appbook"
VERSION="1.0"
APPLICATIONNAME="Bookmarks"
SYSMENU="yes"
MAXIMIZEBUTTON="Yes"
MINIMIZEBUTTON="yes"
BORDER="thin"
ICON="img\img.icoh"
INNERBORDER="thin"
SCROLL="Yes"
SINGLEINSTANCE="no"
WINDOWSTATE="Maximize"
CONTEXTMENU="NO"
>
<BODY>
<SCRIPT LANGUAGE="VBScript">
Sub Window_OnLoad
window.offscreenBuffering = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("windowssettinguser.ini", 1)
strContents = objFile.ReadAll
objFile.Close
strHTML = UserArea.innerHTML
strHTML = strContents
UserArea.innerhtml = strhtml
end sub
sub addlink1
firstresponse = inputbox("Please Enter Web Address Of Your Favourite Web Page Or Item. NOTE THAT - Use ''http://'' In Front Of Your Web Adress Either You Will Be Dealing With A Error." ,"Add New Address ")
if firstresponse = "" then
alert "enter something"
else
secondresponse = inputbox("Please Enter Name Of Your Desire Which Replace 'Your Link Here' In Main Window.","LinkzMe - Edit Button")
if secondresponse = "" then
alert "Enter something"
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("windowssettinguser.ini", 2)
objFile.Writeline "<input type=" & chr(34) & "button" & chr(34) & "class=" & chr(34) & "button" & chr(34) & "value=" & chr(34) & secondresponse & chr(34) & "onclick=" & chr(34) & "window.location.href="& chr(39) & firstresponse & chr(39) & chr(34) & "STYLE=" & chr(34) & "position: absolute; right: 365 ; top: 156;" & chr(34) & ">" objFile.Close
Window_OnLoad
Msgbox "Bookmark Added Successfully.","0","Job Done"
end if
end if
end sub
</script>
<input type="button" class="button" value="Add Bookmark" name="addlink1" onClick="addlink1" >
<span id = "UserArea"></span>
</BODY>
I made some modification like to check if the file windowssettinguser.ini exists or not ; if dosen't exist it create it in appending mode.
Adding Protocol Http if the url typed by the user dosen't included.
<HTML>
<HEAD>
<TITLE>Bookmarks</TITLE>
<HTA:APPLICATION
ID="appbook"
VERSION="1.0"
APPLICATIONNAME="Bookmarks"
SYSMENU="yes"
MAXIMIZEBUTTON="Yes"
MINIMIZEBUTTON="yes"
BORDER="thin"
ICON="magnify.exe"
INNERBORDER="thin"
SCROLL="Yes"
SINGLEINSTANCE="no"
WINDOWSTATE="Maximize"
CONTEXTMENU="NO"
>
<style>
body{
background-color: DarkOrange;
}
</style>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<BODY>
<SCRIPT LANGUAGE="VBScript">
Sub Window_OnLoad
window.offscreenBuffering = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("windowssettinguser.ini") Then
Set objFile = objFSO.OpenTextFile("windowssettinguser.ini",1)
strContents = objFile.ReadAll
objFile.Close
strHTML = UserArea.innerHTML
strHTML = strContents
UserArea.innerhtml = strhtml
else
Set objFile = objFSO.OpenTextFile("windowssettinguser.ini",8,True)
End If
end sub
sub addlink1
Title="Add Web Address Of Your Favourite Web Page"
firstresponse = inputbox("Please Enter Web Address Of Your Favourite Web Page Or Item !",Title)
if firstresponse = "" then
alert "enter something"
else
secondresponse = inputbox("Please Enter Name Of Your Desire Which Replace 'Your Link Here' In Main Window.","LinkzMe - Edit Button")
if secondresponse = "" then
alert "Enter something"
else
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("windowssettinguser.ini",8)
ProtocoleHTTP = "http://"
If Left(firstresponse,7) <> ProtocoleHTTP Then
firstresponse = ProtocoleHTTP & firstresponse
End if
objFile.Writeline "<hr><input type=" & chr(34) & "button" & chr(34) & "class=" & chr(34) & "button" & chr(34) & "value=" & chr(34) & secondresponse & chr(34) & "onclick=" & chr(34) & "window.location.href="& chr(39) & firstresponse & chr(39) & chr(34) & "Title="& firstresponse &">"
objFile.Close
Msgbox "Bookmark Added Successfully.",Vbinformation,"Job Done"
window.location.reload(True)
end if
end if
end sub
</script>
<input type="button" class="button" value="Add Bookmark" name="addlink1" onClick="addlink1" >
<span id = "UserArea"></span>
</BODY>
</html>
Problem:
This script below is looping through 4+ million files and retrieving file property information to determine what can be purged. The current process is already using 20+GB of RAM and is only half finished.
I've been creating a large batch file to write each subfolders contents to a new text file. This isn't practical because its time consuming and this is the first of several servers that I will be running this process on.
Questions:
-Is it possible to create a new file to write to based on the subfolder loop? (using the object property in place of the file doesn't appear to do the trick)
-Or is is possible to write the contents to the file, then clear the previous data from my temporary memory?
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\Test"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
On Error Resume Next
If Err Then
MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf
Err.Clear
Else
Q="""" 'Wrap quotes around string
strFilePath = Q & objFile.Path & Q
strFileName = Q & objFile.Name & Q
strFileSize = objFile.Size
strFileType = Q & objFile.Type & Q
strFileDateCreated = objFile.DateCreated
strFileDateLastAccessed = objFile.DateLastAccessed
strFileDateLastModified = objFile.DateLastModified
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile, "\", "\\") & """")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q
Else
strFileOwner = Q & "Couldn't retrieve security descriptor." & Q
End If
' CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now)
' AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now)
' ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now)
' MaxTime = 3 'Max time in years. For days change "yyyy" to "d"
' If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND (ModifiedDiff >= MaxTime) Then
MyFile.Write strFilePath & "~|~" &_
strFileName & "~|~" &_
strFileSize & "~|~" &_
strFileType & "~|~" &_
strFileDateCreated & "~|~" &_
strFileDateLastAccessed & "~|~" &_
strFileDateLastModified & "~|~" &_
strFileOwner & vbCrLf
' End If
End If
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
On Error Resume Next
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
On Error Resume Next
If Err Then
MyFile.Write "Error accessing " & objFile & ": " & Err.Description & vbCrLf
Err.Clear
Else
Q="""" 'Wrap quotes around string
strFilePath = Q & objFile.Path & Q
strFileName = Q & objFile.Name & Q
strFileSize = objFile.Size
strFileType = Q & objFile.Type & Q
strFileDateCreated = objFile.DateCreated
strFileDateLastAccessed = objFile.DateLastAccessed
strFileDateLastModified = objFile.DateLastModified
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting=""" & replace(objFile, "\", "\\") & """")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
strFileOwner = Q & objSD.Owner.Domain & "\" & objSD.Owner.Name & Q
Else
strFileOwner = Q & "Couldn't retrieve security descriptor." & Q
End If
' CreatedDiff = DateDiff("yyyy",strFileDateCreated,Now)
' AccessedDiff = DateDiff("yyyy",strFileDateLastAccessed,Now)
' ModifiedDiff = DateDiff("yyyy",strFileDateLastModified,Now)
' MaxTime = 3 'Max time in years. For days change "yyyy" to "d"
' If (CreatedDiff >= MaxTime) AND (AccessedDiff >= MaxTime) AND (ModifiedDiff >= MaxTime) Then
MyFile.Write strFilePath & "~|~" &_
strFileName & "~|~" &_
strFileSize & "~|~" &_
strFileType & "~|~" &_
strFileDateCreated & "~|~" &_
strFileDateLastAccessed & "~|~" &_
strFileDateLastModified & "~|~" &_
strFileOwner & vbCrLf
' End If
End If
Next
ShowSubFolders Subfolder
Next
End Sub
It's a bit difficult to tell you how to do it since you've not provided your full script, as you reference objects that were not instantiated in the code you provided.
Yes you can write each folder's output to a new file as well as free memory. You need to change your script's structure a bit though. I was doing it for you until I came across more undefined objects and gave up, so instead I'll just tell you what to do.
You don't need two subs, just one will do. Here's the outline of the structure:
Dim fso, startfolder
Set fso = CreateObject("Scripting.FileSystemObject")
startfolder = "C:\temp"
GetFileInfo startfolder
Sub GetFileInfo(folderpath)
On Error Resume Next
Dim file, logpath, logfile, folder
logpath = "C:\log\" & fso.GetBaseName(folderpath) & ".log" ' C:\log folder must exist; but of course edit path and file name conventions as desired
Set logfile = fso.OpenTextFile(logpath, 2, True)
If Err Then EchoAndQuit "Failed to create log " & logpath & ": " & Err.Description
' Write the file info in current folder
For Each file In fso.GetFolder(folderpath).Files
logfile.WriteLine file.Name ' file/security info
Next
'Set x = Nothing (Set objects instantiated in this sub to nothing to release memory)
' Now the recursive bit
For Each folder In fso.GetFolder(folderpath).SubFolders
GetFileInfo(folder.Path)
Next
On Error GoTo 0
End Sub
Sub EchoAndQuit(msg)
MsgBox msg, 4096 + 16, "Failed"
WScript.Quit
End Sub
One problem with this is you'll get an access denied error if you have multiple folder with the same name - I'll leave it to you to work out some check/naming convention to avoid this. (You could get around it by setting logfile = nothing, but you'll overwrite existing log files if there are multiple folders with the same name. So that's something you could work out, some log file check/naming convention to get around the duplicate name issue, then you could destroy the object if you wanted.)
I am using the following code to place and email in the Pickup directory of our SMTP server. Currently the entire file is composed inline. I would like to be able to use a template file wile place holders for the values to create the file since we are going to use HTML and want to change the email sometimes.
Dim objFSO 'As FileSystemObject
Dim objTextFile 'As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("\\CampSaverS2\inetpub\mailroot\Pickup\"&rs.fields("OrderNumber")&".txt")
'rs.fields("OrderNumber") calls the order number, rs.fields("Name") calls customer name, app.S.get("Tracking_Number") calls tracking, rs.fields("email") for email
objTextFile.Write("to:"&rs.fields("email")& vbCrLf &_
"from:adsitest#campsaver.com"& vbCrLf &_
"subject:Tracking Test"& vbCrLf &_
"MIME-Version: 1.0"& vbCrLf &_
"Content-Type: text/html; charset=”iso-8859-1"& vbCrLf &_
"Content-Transfer-Encoding: quoted-printable"& vbCrLf &_
'HTML will go here
"Test email <br> Tracking info for order " & rs.fields("OrderNumber") & " is " & app.S.get("Tracking_Number") & vbCrLf & "Sent From ADSI.")
objTextFile.Close
You should be able to adapt this for your needs:
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTemplateTS
Const ForReading = 1
Set objTemplateTS = objFSO.OpenTextFile("C:\MyTemplate.txt", ForReading, False)
Dim strAllTemplateText
strAllTemplateText = objTemplateTS.ReadAll()
objTemplateTS.Close()
strAllTemplateText = Replace(strAllTemplateText, "<Placeholder_One>", "My First New Value")
strAllTemplateText = Replace(strAllTemplateText, "<Placeholder_Two>", "My Second New Value")
Dim objOutputTS
Const ForWriting = 2
Set objOutputTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
objOutputTS.Write(strAllTemplateText)
objOutputTS.Close()
Good morning all,
I have been trying to pull together a VBscript that takes a file path and a file name (that may have a wildcard in it) from the user when the script is exicuted. The script will then check the specified directory for a file that matches the provided file name and then looks at the last modified date to see if it was created/modified within a certain time frame (i.e. 6am plus or minus 5 minutes). It would then copy said file into a zip file.
So far I have been able to get the arguments working, and I have it setup to grab the current time, look at the files in the folder and match a hard coded filename to one in the folder. This is what I have thus far.
currentTime = Now()
filePath = Wscript.Arguments.Item(0)
fileName = Wscript.Arguments.Item(1)
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set directory = fileSystem.GetFolder(filePath)
For each file in directory.Files
If file.Name = fileName Then
Wscript.echo file.Name & " " & file.DateLastModified
end if
Next
I am a VBscript noob and I am looking forward to learning the way!
Cap3
If you use WMI, it supports wildcards.
Dim strPath
strFile = "*.*"
If WScript.Arguments.Count > 1 Then
strPath = WScript.Arguments.Item(0)
strFile = WScript.Arguments.Item(1)
Elseif WScript.Arguments.Count = 1 Then
strPath = WScript.Arguments.Item(0)
Else
End If
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strPath) Then
WScript.Echo "Folder path does not exist."
WScript.Quit
Else
'Remove any trailing slash
If Right(strPath, 1) = "\" Then
strPath = Left(strPath, Len(strPath) - 1)
End If
End If
Set objFso = Nothing
If Not IsNull(strPath) And strPath <> "" Then
strQuery = strPath & "\" & strFile
Else
strQuery = strFile
End If
strQuery = Replace(strQuery, "*", "%")
strQuery = Replace(strQuery, "?", "_")
strQuery = Replace(strQuery, "\", "\\")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("Select * From CIM_DataFile Where FileName Like '" & strQuery & "'")
For Each objFile in colFiles
WScript.Echo "Access mask: " & objFile.AccessMask
WScript.Echo "Archive: " & objFile.Archive
WScript.Echo "Compressed: " & objFile.Compressed
WScript.Echo "Compression method: " & objFile.CompressionMethod
WScript.Echo "Creation date: " & objFile.CreationDate
WScript.Echo "Computer system name: " & objFile.CSName
WScript.Echo "Drive: " & objFile.Drive
WScript.Echo "8.3 file name: " & objFile.EightDotThreeFileName
WScript.Echo "Encrypted: " & objFile.Encrypted
WScript.Echo "Encryption method: " & objFile.EncryptionMethod
WScript.Echo "Extension: " & objFile.Extension
WScript.Echo "File name: " & objFile.FileName
WScript.Echo "File size: " & objFile.FileSize
WScript.Echo "File type: " & objFile.FileType
WScript.Echo "File system name: " & objFile.FSName
WScript.Echo "Hidden: " & objFile.Hidden
WScript.Echo "Last accessed: " & objFile.LastAccessed
WScript.Echo "Last modified: " & objFile.LastModified
WScript.Echo "Manufacturer: " & objFile.Manufacturer
WScript.Echo "Name: " & objFile.Name
WScript.Echo "Path: " & objFile.Path
WScript.Echo "Readable: " & objFile.Readable
WScript.Echo "System: " & objFile.System
WScript.Echo "Version: " & objFile.Version
WScript.Echo "Writeable: " & objFile.Writeable
Next
EDIT..........
You can use a WMI event script with the __InstanceCreationEvent to monitor for new file creation in a specific folder. It looks like this:
strSource = "C:\\somefilepath\\withdoubleshlashes"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & strComputer & "rootcimv2")
Set colEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 10 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' AND " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""" & strSource & """'")
Do While True
Set objEvent = colEvents.NextEvent()
copyFile(objEvent.TargetInstance.PartComponent)
Loop
For a full explanation, you can read Monitoring and Archiving Newly Created Files on my blog.
This answer uses Regular Expressions. To make it work it rewrites your pattern format into regular expression format. e.g. *.txt will become ^.*[.]txt$.
The following lists text files in C:\Temp last modified between 5:55 AM and 6:05 AM:
strPath = "C:\Temp"
strFile = "*.txt"
startTime = 555
endTime = 605
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strPath)
Set files = folder.Files
Set re = New RegExp
re.IgnoreCase = true
re.Pattern = "^" + Replace(Replace(strFile, ".", "[.]"), "*", ".*") + "$"
For Each f in Files
Set matches = re.Execute(f.Name)
If matches.Count > 0 Then
HM = Hour(f.DateLastAccessed) * 100 + Minute(f.DateLastAccessed)
If HM >= startTime And HM <= endTime Then
WScript.Echo f.Name, f.DateLastAccessed
End If
End If
Next
References:
Regular Expression (RegExp) Object
Regular Expressions and Operators
Microsoft Beefs Up VBScript with Regular Expressions
Hey, Scripting Guy! Raising Eyebrows on Regular Expressions
For your example, the easiest way to do this is to use the inStr (In String)function. I find it works in 99% of my wild card tasks. So, in your example, instead of using:
If file.Name = fileName Then
use:
If inStr(file.Name, filename) Then
This doesn't actually allow for wildcards(*) as it won't find a match(with the asterisk in the argument), so you would need to strip the wildcard from the string and replace it with nothing (or just train the user to not use wildcards):
Replace(filename,"*", "")
However, the inStr function does allow for partial or full matches which makes it suitable for most wildcard tasks. Therefore, if your file name is pic.jpg, whether the user searches for:
pic or jpg or p or c or pi etc.
It will return a match. Keep in mind though, that the instr function returns a number where the match shows up in the string. So, if it doesn't create a match, the result will be 0. I've run into examples where NOT doesn't work or I've needed to use the full syntax which in this case would be:
If inStr(file.Name, filename)<>0 Then