VB Do While only works for one iteration - vbscript

I've never done anything before with VB and am trying to work out a little problem with this script. Basically the script should look for all jpgs in a folder, if the file name exists already remove it from the target folder, add the value to a table and then rename the source file so it exists in the target folder.
This script works to an extent, for example it will rename any file if the file doesn't exist already but for any files that do already exist it processes only one then then ends. I can run it multiple times to clear the rest but would rather it cleared them all in one go. I have done quite a bit of reading but can't see what is going wrong. Can anyone shed any light on this?
Public Function GetLPUFileAddress()
Dim strSourceFolder As String
Dim strFile As String
Dim strTargetFolder As String
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
strSourceFolder = "C:\Users\Images\LPU-HOLDING\"
strFile = Dir(strSourceFolder & "*.JPG")
strTargetFolder = "C:\Users\Images\LPU\"
Do While strFile <> ""
If Dir(strTargetFolder & strFile) <> "" Then Kill strTargetFolder & strFile
CurrentDb.Execute "INSERT INTO TBL_LPU ( File_Name, Import_Date ) VALUES ('" & strFile & "',Date())"
Name strSourceFolder & strFile As strTargetFolder & strFile
strFile = Dir
Loop
End Function

By calling the Dir() function with an appropriate filter, such as "C:\Users\Images\LPU\*.JPG", you start enumeration and get the first file name.
After that, repeatedly calling the Dir() function without any parameters, you will get all *.JPG file names, one for each call.
If you at any point call Dir() with a parameter, this will reset the current enumeration and start a new one.
You therefore can't use Dir() to check existance of a file in a folder while you're enumerating with Dir(). This resets the enumeration.
You have to either use some other way of checking existance of the file, or just try to kill it without checking, ignoring the error.

Related

open and write 2 files

I need create one script for open one file (Server.txt → content all servers names) and create logfile with ServerName (example: Server1.txt). After that I need WriteLine in this logfile result of the script retrieve registry values.
I have one script working retrieve all registry values but I need to create each FileLog with ServerName.
I think cannot use two Opentextfile before close one.
Can we help me?
This is code I'm using for test:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("Servers.txt")
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
Set objFile2 = objFSO.CreateTextFile(strComputer & ".txt",True)
set objHtml=objFSO.OpenTextFile(objFile2,8,true)
objHtml.WriteLine Now() & VbTab & RegResultQuery
objHtml.Close
Loop
You can call OpenTextFile twice, but you can't open the same file twice without closing it first. From what I see you don't need to open the file twice, though. CreateTextFile already returns a handle to the file, so you can simply use objFile2 throughout the loops.

Replace text within a file

Hello I've tried a lot of researching but cant find what I need and haven't been able to successfully piece this together myself.
Each of my users have a XML file within their profile that I would like to edit. The file contains a reference to their computer name and clientname, which are out of date each time they login to a new terminal. I need to replace these with the current computername and clientname. The bit I cannot figure out how to do is how to search the XML for the computername when I only know the first few characters, then replace it.
my XML will have any entry something like this
"InstalledPrinter name="\WHBCVDI0109\LabelPrinter650 (from IGEL-00E0C533943E)"
I need to search the file and replace the WHBCVDI0109 and the IGEL-00E0C533943E with the correct entries. My script successfully gets those entries I just dont know how to find and replace them in the file.
My script looks like this:
Const ForReading = 1
Const ForWriting = 2
Set oShell = CreateObject( "WScript.Shell" )
'Get Variables
user=oShell.ExpandEnvironmentStrings("%UserName%")
appdata=oShell.ExpandEnvironmentStrings("%appdata%")
strComputerName = oshell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
'Set XML location
strfile = appdata & "\Smart Label Printer\SlpUserConfig.xml"
'Open
Set objfso = CreateObject("Scripting.FileSystemObject")
Set filetxt = objfso.OpenTextFile(strfile, ForWriting)
strTemp = "HKEY_LOCAL_MACHINE\SOFTWARE\Citrix\ICA\Session\ClientName"
WScript.Echo "client name is : " & oShell.RegRead(strTemp)
An pointers would be much appreciated.
You shouldn't use the FileSystemObject and String/RegExp operations to edit an XML file. Using the canonical tool - msxml2.domdocument - is less error prone and scales much better.
See here for an example (edit text); or here for another one (edit attribute).
If you publish (the relevant parts of) your .XML file, I'm willing to add same demo code specific for your use case here.

Using VBScript to examine properties of files within a zip file

I'm trying to use VBScript to examine the contents of several hundred .zip files. Essentially what I want to do is run through each .zip and find all of the files wihtin that zip file. For each one of these files within the zip, I want to record some information about it to an Oracle database. That information being: file name and file modified date.
So far, my solution has been extracting each zips folder structure to a temp folder then running through the temp folder with an fso object. However, this has been proven to be very slow.
Is there a way to accoplish this without unziping the zip files?
Ouch man. I have never heard of vbscript zip object. But it has been a long time since I have done vbscript. Is there anyway you can avoid it?
I did some googling for you. I did find this: http://www.example-code.com/vbscript/zip_List.asp Chilkat has done a lot of stuff I thought not possible. This gives me the impression - that what you are trying to do is not going to be painless.
If given the problem you have I would find a different solution than vbscript. But if you pull-it-off I would vote for you to be mayor of vb land
You can do it in place with Shell Objects. But it will be just as slow, maybe. If just name and date Explorer may get it direct from the zip directory (at the end of the file so the whole file still needs to be read).
This copies items in a folder to another folder. A zip file is a folder so it will copy in and copy out.
To Zip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set SrcFldr=objShell.NameSpace(Ag(1))
Set DestFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
To Unzip (note SrcFolder and DestFolder are reversed)
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set DestFldr=objShell.NameSpace(Ag(1))
Set SrcFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
To Create a blank zip. (I should have used an ADODB binary stream rather than an FSO text stream, but it shouldn't matter)
Set Ag=Wscript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Ag(0), 8, vbtrue)
BlankZip = "PK" & Chr(5) & Chr(6)
For x = 0 to 17
BlankZip = BlankZip & Chr(0)
Next
ts.Write BlankZip

VB script - search for a file in directory

I am trying to write a VB script (having never attempted before) - I need it to search the folder'\file001\source$' - whilst in the folder search for all 'Update.exe'files - If this is done manually, in Windows it takes a long long time!
I would like all the files that it finds with this name - to be copied into a new folder.
Looking at various help forums I am getting more and more confused.
Below is what I have attempted:
Set fso = CreateObject("Scripting.FileSystemObject")
ShowSubfolders fso.GetFolder("\\file001\source$")
'foldername = "\file001\source$"
'filename = "Updater.exe"
Function ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Wscript.Echo Subfolder.Path
ShowSubFolders Subfolder
Next
End Function
This is to search through a folder, recursively through the folders sub folders to find all files with this name.
I have also done research into -directory.getfiles. But have no clue if this is the right direction.
As a newbie to VB script, I have researched and attempted to play around with vb script, to get the function I desire. I would be grateful to any help I can get.
Again - my target is to - find all files within the given folder and subfolders with the name update.exe - and then to copy these files found into a new folder.
Thank you in advance.
If you only want to check the content of a single folder for the existence of a particular file you can do that like this:
Set fso = CreateObject("Scripting.FileSystemObject")
foldername = "\\file001\source$"
filename = "Update.exe"
If fso.FileExists(fso.BuildPath(foldername, filename)) Then
WScript.Echo filename & " exists."
End If
If you want to check the subfolders of foldername as well, you need to recurse into subfolders with something like this. You can either integrate the check from the above code sample in the loop over the subfolders, or add another loop over the files in the folder:
Set fso = CreateObject("Scripting.FileSystemObject")
CopyUpdater fso.GetFolder("\\file001\source$")
Sub CopyUpdater(fldr)
For Each f In fldr.Files
If LCase(f.Name) = "update.exe" Then
'copy file to somewhere else
End If
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
See my question here, i benchmark three languages (vbscript also) which do a subdirectory traversal with full working samples and optimised for the language. benchmarks: does python have a faster way of walking a network folder?
Thats a good attempt . Read more on below link and understand things better .
Vbscript list all PDF files in folder and subfolders
VBScript to traverse through subdirectories
dim sFilename
Dim objDict
Set objDict=CreateObject("Scripting.Dictionary")
sFilename = ""
'root folder path where subfolder exists
fileLocation="C:\Users\u258251\Desktop\TestSubfolder"
Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Add all files with specific extention to dictonary
Call Recurse(fileLocation)
ItemArray = objDict.Items
'Loop through dictonary
For i = 0 To objDict.count -1
sFilename = sFilename & ItemArray(i) & VBCRLF
Next
msgbox(sFilename)
'find a specific file by name and return path
if objDict.Exists("DP103.txt") then
msgbox(objDict.Item("DP103.txt"))
end if
Sub Recurse(strFolderPath)
Dim objFolder
Set objFolder = objFSO.GetFolder(strFolderPath)
Dim objFile
Dim objSubFolder
For Each objFile In objFolder.Files
If (InStr(objFile.Name, ".") > 0) Then
'proceed if extention is .txt
If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".txt") Then
if objDict.Exists(objFile.Name)=false then
'add files and path to dictonary
objDict.Add objFile.Name,objfile.Path
End if
End if
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call Recurse(objSubFolder.Path)
Next
End Sub

Script to download file and rename according to date on Windows Vista machine?

I need to daily run a script that will download a file from a fixed location and save it on my computer with an appropriate filename-YYYYMMDD-HHSS.ext timestamp. I need a historical record of what that file was at that particular time. I can manually check and see what the changes were, so compairson not needed.
(I was looking for an online service that would do this for me, but I think a locally running script on my machine would be good enough).
Although i do have php on my machine, i would prefer if its a pure windows builtin solution, just in case i have to (likely) adapt it to someone else's system (non-techies).
If someone has something like this and can contribute the code - help would be most appreciated!!
D
Your task can be easily scripted using Windows Script Host languages -- VBScript or JScript.
To download a file from Internet, you can use the XMLHTTP object to request the file contents from the server and then use the ADO Stream object to save it to a file on the disk.
As for the timestamp, the problem is that neither VBScript nor JScript have built-in functions that would format the date in the format you need, so you will have to write the code for doing this yourself. For example, you could split the date into parts, pad them if necessary and concatenate them back together. Or you could use the WMI SWbemDateTime object that uses the yyyymmddHHMMSS.mmmmmmsUUU date format, and simply extract the yyyymmddHHMMSS part from it.
Anyway, here's a sample script (in VBScript) that illustrates the idea. I hard-coded the original file name in the strFile variable, because I was too lazy to extract in from the URL (and also in case the URL doesn't specify the file name, like in http://www.google.com).
Dim strURL, strFile, strFolder, oFSO, dt, oHTTP, oStream
strURL = "http://www.google.com/intl/en_ALL/images/logo.gif" ''# The URL to download
strFile = "logo.jpg" ''# The file name
strFolder = "C:\Storage" ''# The folder where to save the files
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
''# If the download folder doesn't exist, create it
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
''# Generate the file name containing the date-time stamp
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
strFile = oFSO.GetBaseName(strFile) & "-" & Split(dt.Value, ".")(0) & "." & oFSO.GetExtensionName(strFile)
''# Download the URL
Set oHTTP = CreateObject("MSXML2.XMLHTTP")
oHTTP.open "GET", strURL, False
oHTTP.send
If oHTTP.Status <> 200 Then
''# Failed to download the file
WScript.Echo "Error " & oHTTP.Status & ": " & oHTTP.StatusText
Else
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = adTypeBinary
oStream.Open
''# Write the downloaded byte stream to the target file
oStream.Write oHTTP.ResponseBody
oStream.SaveToFile oFSO.BuildPath(strFolder, strFile), adSaveCreateOverWrite
oStream.Close
End If
Feel free to ask if you need more explanation.
A version control system like Mercurial can do this for you without you having to rename the file. The script might be as simple as (get wget here and Mercurial here):
wget http://blah-blah-blah.com/filename.ext
hg commit -m "Downloaded new filename.ext"
A nice feature of this is that the commit won't happen unless the file's contents have changed.
To see the history, use hg log or TortoiseHg (a shell extension).
Build up on:
http://blog.netnerds.net/2007/01/vbscript-download-and-save-a-binary-file/
and
http://developernotes.thomaspowell.com/2008/06/vbscript-to-convert-timestamp-to.php

Resources