Does anyone know of a method to determine when a file copy completes in VBScript? I'm using the following to copy:
set sa = CreateObject("Shell.Application")
set zip = sa.NameSpace(saveFile)
set Fol = sa.NameSpace(folderToZip)
zip.copyHere (Fol.items)
Do Until zip.Items.Count = Fol.Items.Count
WScript.Sleep 300
Loop
When the loop finishes your copy is finished.
But if you only want to copy and not zip, FSO or WMI is better.
If you are zipping and want them in a file you have to create the zip-file yourself, with the right header first. Else you only get compressed files/folders IIRC. Something like this:
Set FSO = CreateObject( "Scripting.FileSystemObject" )
Set File = FSO.OpenTextFile( saveFile, 2, True )
File.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
File.Close
Set File = Nothing
Set FSO = Nothing
The 2 in OpenTextFile is ForWriting.
You may have better luck using the Copy method on a FileSystemObject. I've used it for copying, and it's a blocking call.
Const FOF_CREATEPROGRESSDLG = &H0&
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
strSource = " " ' Source folder path of log files
strTarget = " .zip" ' backup path where file will be created
AddFilesToZip strSource,strTarget
Function AddFilesToZip (strSource,strTarget)
Set r=fso.GetFolder(strSource)
set file = fso.opentextfile(strTarget,ForWriting,true)
file.write "PK" & chr(5) & chr(6) & string(18,chr(0))
file.Close
Set shl = CreateObject("Shell.Application")
i = 0
For each f in r.Files
If fso.GetExtensionName(f) = "log" Or fso.GetExtensionName(f) = "Log" Or fso.GetExtensionName(f) = "LOG" Then
shl.namespace(strTarget).copyhere(f.Path)', FOF_CREATEPROGRESSDLG
Do until shl.namespace(strTarget).items.count = i
wscript.sleep 300
Loop
End If
i = i + 1
Next
set shl = Nothing
End Function
Related
Ive written some code that loops through text files in a folder and updates them with an addiotnal header "TREATMENT_CODE" and then appends a code to the end of each line within each text file. The code is taken from the txt file name. Ive set this as a variable called TCode. The problem Im having is that the TCode variable isn't changing after the first loop through. Can anybody help? Thanks
Please excuse all of the msgbox lines, just me using them to figure out whats going on.
Code:
Option Explicit
Dim FSO, FLD, FIL, TS
Dim strFolder, strContent, strPath, FileName, PosA, TCode, rfile, Temp, dataToAppend, fulldata, wfile, TempArr, i
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Change as needed - this names a folder at the same location as this script
strFolder = "C:\Users\User1\OneDrive - Company/Documents\Temporary_delete_every_month\CRM_combiner_macro\Looping_test\files to amend"
'Create the filesystem object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get a reference to the folder you want to search
set FLD = FSO.GetFolder(strFolder)
'loop through the folder and get the file names
For Each Fil In FLD.Files
'MsgBox Fil.Path
'If UCase(FSO.GetExtensionName(Fil.Name)) = ".txt" Then
strPath = Fil.Path
'msgbox strPath
'strPath = Replace(strPath,"""","")
'msgbox strPath
posA = InStrRev(strPath, "\") +1
TCode = "|" & Mid(strPath, posA, 11)
msgbox "this is TCode " & TCode
Set fso = CreateObject("scripting.filesystemobject")
'msgbox "next file to amend" & strPath
Set rfile = fso.OpenTextFile(strPath, ForReading) 'File opened in Read-only mode
While Not rfile.AtEndOfStream
temp=rfile.ReadLine()
If rfile.Line=2 Then
dataToAppend = "|TREATMENTCODE"
ElseIf rfile.Line=3 Then
dataToAppend = TCode
End If
fulldata = fulldata & temp & dataToAppend & "|||"
Wend
rfile.Close
fulldata = Left(fulldata,Len(fulldata)-2)
Set wfile = fso.OpenTextFile(strPath, ForWriting) 'File opened in write mode
tempArr = Split(fulldata,"|||")
For i=0 To UBound(tempArr)
wfile.WriteLine tempArr(i)
Next
wfile.Close
Set fso= Nothing
'End If
'Clean up
Set TS = Nothing
Set FLD = Nothing
Set FSO = Nothing
set rfile = Nothing
set wfile = Nothing
set tempArr = Nothing
set Temp = Nothing
set TCode = Nothing
Next
MsgBox "Done!"
I have a system that auto-generate testdata_1.txt, testdata_2.txt and so on. I wish to read the file that begins with testdata_ and process it, how do I go about this? I have tried using testdata_* but in the following code but it doesn't work. Any help is appreaciated. Thank you very much.
sPath = "database/"
sFile = "testdata_*.txt"
sFileName = sPath & sFile
Set fso = Server.CreateObject("Scripting.FileSystemObject")
set fs = fso.OpenTextFile(Server.MapPath(sFileName), 1, true)
if not fs.AtEndOfStream then
Do while not fs.AtEndOfStream
This can help you:
sPath = "database/"
sFile = "testdata_"
'Modify this line to indicate the disk drive where the files are located.
sDir = "C:\" & sPath
Set obj_FS = CreateObject("Scripting.FileSystemObject")
Set obj_FolderBase = obj_FS.GetFolder(sDir)
For Each obj_File In obj_FolderBase.Files
If Mid(obj_File.Name,1,9) = sFile then
set objReadFile = obj_FS.OpenTextFile (obj_File.Name, 1, False)
content = objReadFile.ReadAll
objReadFile.close
Wscript.Echo content
End If
Next
Loop through the folder choosing which files you want. I use Left() here.
'On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Dirname = InputBox("Enter Dir name")
Set fldr = fso.GetFolder(Dirname)
Set Fls = fldr.files
On Error Resume Next
For Each thing in Fls
If Left(thing.name,9) = "TestData_" then
msgbox thing.name
End If
Next
I am receiving the object required error on the following line, although fl4 is a defined variant/object/file:
oFold.CopyHere (fl4)
Any thoughts would be appreciated.
Below is an applicable excerpt of code. I have excluded the recursive loop and directory sub folder iteration:
srcpth = rs1.Fields("Src_File_Path").Value
destpth = rs1.Fields("Zip_File_Path").Value
var = 0
Set FS2 = New FileSystemObject
Set FS2 = CreateObject("Scripting.FileSystemObject")
Set fl1 = FS2.GetFolder(srcpth)
For Each fl2 In FS2.GetFolder(srcpth).SubFolders
var = 2
ZipFile = Application.CurrentProject.Path & "\tmp\" & fl2.Name & ".zip"
Set FS3 = CreateObject("Scripting.FileSystemObject")
FS3.CreateTextFile(ZipFile, True).Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
Set FS3 = Nothing
Set FS4 = New FileSystemObject
Set FS4 = CreateObject("Scripting.FileSystemObject")
Set fl3 = FS4.GetFolder(fl2)
For Each fl4 In FS4.GetFolder(fl2).Files
var = 2
GoTo Zipxchg
zipxchg_2:
Next
Next
Set FS1 = Nothing
Set oFld = Nothing
Set oApp = Nothing
Set oShl = Nothing
Exit Sub
Zipxchg:
If var = 2 Then
ZipFile = Application.CurrentProject.Path & "\tmp\" & fl2.Name & ".zip"
Set oApp = CreateObject("Shell.Application")
Set oFld = oApp.NameSpace(CVar(ZipFile))
Set FilestoZip = objShell.File(fl4)
i = oFld.Items.Count
oFold.CopyHere (fl4)
Set oShl = CreateObject("WScript.Shell")
GoTo zipxchg_2
End Sub
remove the brackets .... use oFold.CopyHere fl4 .... brackets cause a value to be returned, but there is no variable (object) to receive it
New to VBScript and having a problem grasping this concept.
This is the code:
Set WshNetwork = WScript.CreateObject("WScript.Network")
strCompName = WshNetwork.Computername
Wscript.Echo WshNetwork.Username >j:\strCompName.txt
WScript.Quit()
Basically I want to the username dumped to a text file and the text file should be named with the name of the computer. I've tried putting the strCompName in quotes, single quotes, parenthesis with no success.
Here is the code that you can use. You need to use FileSystemObject. The FileSystemObject is used to gain access to a computer's file system. It can create new files and access existing ones.
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strCompName = WshNetwork.Computername
'writing to file
outFile="c:\TEMP\" & strCompName & ".txt"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write WshNetwork.Username & vbCrLf
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Set WshNetwork = Nothing
WScript.Quit()
Save this in .vbs file and run and you will get a text file with computer name in TEMP folder (Change the path if you like).
This code should work. This code opens the file and appends it if the file exists or creates a file and writed to it if it does not exist.
'constants
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'Load domain, username, & computer variables
Set oShell = CreateObject( "WScript.Shell" )
sDomain = oShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )
sUserName = oShell.ExpandEnvironmentStrings( "%USERNAME%" )
sComputer = oShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
'Setup filesystemobject
Set oFSO=CreateObject("Scripting.FileSystemObject")
'Check to see if file exists. If exists open it forAppending
'else create file and write to it.
outFile="c:\export\" & sComputer & ".txt"
If oFSO.FileExists(outFile) Then
Set objFile = oFSO.OpenTextFile(outFile, ForAppending, True, TristateTrue)
Else
Set objFile = oFSO.CreateTextFile(outFile,True)
End If
'write to file
objFile.WriteLine sDomain & "\" & sUsername & " - " & Now
'clean up objects
objFile.Close
Set objFile = Nothing
Set oFSO = Nothing
Set oShell = Nothing
Please advice how changes the current single incoming log file to search multiple files.
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
strTextToFind = Inputbox("Enter the text you would like to search for.")
strInputFile = "C:\Users\mmmanima\Desktop\mani\Day_16.txt"
iF YOU CAN NOTICED, IM ONLY ACCESS THE day_16 FILE
strOutputFile = "C:\Users\mmmanima\Desktop\texting As\result.txt"
Set objFSO = CreateObject("Scripting.FilesystemObject")
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
WScript.Quit
VBScript required to search userinput string into the share folder and there is 60 files.
As I believe you want to search through the all files in a particular folder. Then I suggest you to loop you action while all files are read
to do that it's easier to maintain sub or function
pseudo:
var inputFolder = ".\myfolder"
foreach file in the inputFolder
{
inputFile = file
searchIn(inputFile)
}
sub searchIn(inputFile)
{
'do your current works here
}
code:
This part will give you the all file names
Set fso = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = fso.getFolder(inputFldr)
For Each file In fldr.Files
'call to your function
Next
----------plese aware of typos------
Dim strTextToFind, strInputFile, strOutputFile, boolMatchCaseSensitive
Dim objFSO, objInputFile, strFoundText, strLine, objOutputFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
inputFldr = Replace(wscript.scriptfullname,wscript.scriptname,".\")
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for.")
For Each file In fldr.Files
yourFunctionName(file )
Next
sub yourFunctionName(inputFile)
strInputFile = inputFile
strOutputFile = ".\result.txt"
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine strFoundText
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
end sub
WScript.echo "done"
WScript.Quit
You can try this vbscript, i added a function BrowseForFolder()
Option Explicit
Dim strTextToFind,inputFldr,strInputFile,strOutputFile,path,fldr
Dim objFSO, objInputFile,strFoundText,strLine,objOutputFile,file,ws
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.Shell")
path = objFSO.GetParentFolderName(wscript.ScriptFullName)
strOutputFile = path & "\result.txt"
If objFSO.FileExists(strOutputFile) Then
objFSO.DeleteFile(strOutputFile)
End if
inputFldr = BrowseForFolder()
Set fldr = objFSO.getFolder(inputFldr)
strTextToFind = Inputbox("Enter the text you would like to search for it !","Enter the text you would like to search for it !","wscript")
For Each file In fldr.Files
Call Search(file,strTextToFind)
Next
ws.run strOutputFile
'***************************************************************************************************************
Sub Search(inputFile,strTextToFind)
strInputFile = inputFile
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
Set objInputFile = objFSO.OpenTextFile(strInputFile,intForReading, False)
Do until objInputFile.atEndOfStream
strLine = objInputFile.ReadLine
If InStr(strLine,strTextToFind) > 0 Then
strFoundText = strLine
If strFoundText <> "" Then
Set objOutputFile = objFSO.OpenTextFile(strOutputFile,intForAppending, True)
objOutputFile.WriteLine "The Path of file ===> "& DblQuote(strInputFile) & VbCRLF &_
"String found "& DblQuote(strTextToFind) & " ===> "& DblQuote(strFoundText) & VbCRLF & String(100,"*")
objOutputFile.Close
Set objOutputFile = Nothing
End If
End If
loop
objInputFile.Close
Set objInputFile = Nothing
End sub
'***************************************************************************************************************
Function BrowseForFolder()
Dim ws,objFolder,Copyright
Set ws = CreateObject("Shell.Application")
Set objFolder = ws.BrowseForFolder(0,"Choose the folder to search on it ",1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
BrowseForFolder = objFolder.self.path
end Function
'****************************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************
A bit late in the day after such a long time gap to address Mara Raj's problem with Hackoo's script but here it is for any others who may be interested. On starting the script it automatically deletes any existing result.txt file. Should the script subsequently go on to find "no match" it fails to generate a results.txt file as it would normally do if there were a match. The simplest way to correct this is to insert:
If objFSO.FileExists(strOutputFile) Then
else
wscript.echo "No Matches Found"
wscript.Quit
end if
between "next" and "ws.run strOutputFile"