ASP Creating Text File ObjFileSys.CreateTextFile - vbscript

I am trying to create a textfile in a temp directory...
I don't understand what I am doing wrong...
My Error is:
Microsoft VBScript runtime error '800a004c'
Path not found
/racklabels/desktop/printLabel.asp, line 128
There is a temp directory on my server I am running this from...
strFileNameQAD = "C:\temp\" & strFileNameRBB
'Create the files, write to them & close them.
If bBackFlush = True Then
Set filQAD = objFileSys.CreateTextFile(strFileNameQAD)
filQAD.WriteLine ("H::" & strPart & strLocation & strSite & strQty & strSerial & strRef & strUserID & strAccount & strSubAccount & strCostCenter & strEffDate & strYes)
filQAD.WriteLine ("D::" & strFromLocation & strNo & strUserID)
filQAD.Close
Set filQAD = Nothing
End If

The FileSystemObject is complaining about the path contained in the strFileNameQAD, try placing a Response.Write strFileNameQAD : Response.Flush before the offending line to see what strFileNameQAD outputs as.
Note: Response.Flush causes the server to write the response headers and buffer, so even if your script errors the output will be shown first.
strFileNameQAD = "C:\temp\" & strFileNameRBB
'Create the files, write to them & close them.
If bBackFlush = True Then
'Output strFileNameQAD variable to check content
Response.Write strFileNameQAD : Response.Flush
Set filQAD = objFileSys.CreateTextFile(strFileNameQAD)
filQAD.WriteLine ("H::" & strPart & strLocation & strSite & strQty & strSerial & strRef & strUserID & strAccount & strSubAccount & strCostCenter & strEffDate & strYes)
filQAD.WriteLine ("D::" & strFromLocation & strNo & strUserID)
filQAD.Close
Set filQAD = Nothing
End If
Does the strFileNameQAD variable contain the expected path? My guess would be that strFileNameRBB is empty so the FileSystemObject sees C:\temp\ but no file to create, hence the error.

Related

VBScript Macro getParentFolder Name

I am trying to create a vbscript macro which would get the folder location in which the macro is stored and create the output files into the same folder. I am using the below code but its not getting the correct location
Set obj1FSO = CreateObject("Scripting.FileSystemObject")
folderLoc = obj1FSO.GetParentFolderName("\Cubes_Macro_V5.zmc")
It would then use the folderLoc variable and append the output file name to it in order to create the output file in the same folder as where the macro is stored.
Set repFso = CreateObject("Scripting.FileSystemObject")
Set repFile = repFso.CreateTextFile(folderLoc & "RCHT_OPTION4_REPORT.txt", True)
The Macro is stored in a folder in the D:\ drive but when I run the above segment of code it get the location for the desktop.
https://msdn.microsoft.com/en-us/library/22dyy47c%28v=vs.84%29.aspx
That is not how the method works - it extracts the "parent" from the string provided.
Option Explicit
Dim fso,GetTheParent
Set fso = CreateObject("Scripting.FileSystemObject")
GetTheParent = fso.GetParentFolderName("C:\Windows")
wscript.echo "Attempt 1:" & "'" & GetTheParent & "'"
GetTheParent = fso.GetParentFolderName("\Windows")
wscript.echo "Attempt 2:" & "'" & GetTheParent & "'"
GetTheParent = fso.GetParentFolderName("Windows")
wscript.echo "Attempt 3:" & "'" & GetTheParent & "'"
GetTheParent = fso.GetParentFolderName("C:\WINDOWS\system32")
wscript.echo "Attempt 4:" & "'" & GetTheParent & "'"
GetTheParent = fso.GetParentFolderName("\WINDOWS\system32")
wscript.echo "Attempt 5:" & "'" & GetTheParent & "'"
Results:
Attempt 1:'C:\'
Attempt 2:''
Attempt 3:''
Attempt 4:'C:\WINDOWS'
Attempt 5:'\WINDOWS'
There is a difference between the current directory ('where you are when you start the process') and the script's directory:
>> WScript.Echo 0, goFS.GetAbsolutePathName(".\")
>> WScript.Echo 1, goWS.CurrentDirectory
>> WScript.Echo 2, goFS.GetParentFolderName(WScript.ScriptFullName)
>>
0 C:\Documents and Settings\eh
1 C:\Documents and Settings\eh
2 M:\bin
(I called my REPL/Interactive VBS shell that resides in m:\bin from my home directory)
I don't know if "Cubes_Macro_V5.zmc" is a VBScript file (with a special extension that is loaded by whatever agent you use via w|cscript.exe), but check if WScript.ScriptFullName has the expected content and apply .GetParentFolderName.
If that fails, you need to determine the folder that your agent uses for macros and feed that directory to .BuildPath.
On second thought:
Voodoo but easy to test: Does
WScript.Echo 0, goFS.GetAbsolutePathName(".\Cubes_Macro_V5.zmc")
deliver the desired result?

exception handling and skip text messages

My script is basically the same as last time, but there are some bonus features I'm having problems with.
Is there something similar to exception handling in VBScript? I've read about it and I'm not to sure and is there a way if the script gets canceled for not existing path folders, to create them and continue/restart?
Is there a way how I'm able to skip (They've to be there, but it would be fancy if I could be able to skip them.) at the beginning of the script all these text messages and how is it done?
Here's the code I've got so far:
Set fso = CreateObject("Scripting.FileSystemObject")
Function Pad(s)
Pad = Right("00" & s, 2)
End Function
Sub CopyFiles(fldr, dst)
'Copy all files from fldr to destination folder and append the date (in ISO
'format) to the name. Overwrite existing files.
For Each f In fldr.Files
created = Year(f.DateCreated) & "-" & Pad(Month(f.DateCreated)) & "-" & _
Pad(Day(f.DateCreated)) & "_" & Pad(Hour(f.DateCreated)) & _
Pad(Minute(f.DateCreated)) & Pad(Second(f.DateCreated))
newname = fso.GetBaseName(f) & "_" & created & "." & fso.GetExtensionName(f)
WScript.Echo "Aktuelles File, welches gerade kopiert wird: " & newname
f.Copy fso.BuildPath(dst, newname), True
Next
'Recurse into subfolders.
For Each sf In fldr.SubFolders
CopyFiles sf, dst
Next
End Sub
CopyFiles fso.GetFolder("C:\test"), "C:\test1"
How do I have to implement "On Error Resume Next"?
I've done something like this right now and I'm not to sure if it's correct:
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("C:\test") Then
On Error Goto 0
Dim StartFolder, TargetFolder
StartFolder = "C:\test"
TargetFolder = "C:\test1"
Function Pad(s)
Pad = Right("00" & s, 2)
End Function
Sub CopyFiles(fldr, dst)
'Copy all files from fldr to destination folder and append the date (in ISO
'format) to the name. Overwrite existing files.
For Each f In fldr.Files
created = Year(f.DateCreated) & "-" & Pad(Month(f.DateCreated)) & "-" & _
Pad(Day(f.DateCreated)) & "_" & Pad(Hour(f.DateCreated)) & Pad(Minute(f.DateCreated)) & Pad(Second(f.DateCreated))
newname = fso.GetBaseName(f) & "_" & created & "." & fso.GetExtensionName(f)
If UCase(FSO.GetExtensionName(f.name)) = "JPG" Then
f.Copy fso.BuildPath(dst, newname), True
WScript.Echo "Ich kopiere: " & StartFolder & "\" & f.name & " nach " & TargetFolder & "\" & newname
End If
Next
'Recurse into subfolders.
For Each sf In fldr.SubFolders
CopyFiles sf, dst
Next
End Sub
CopyFiles fso.GetFolder("C:\test"), "C:\test1"
End If
On Error Resume Next
f.Copy fso.BuildPath(dst, newname), True
If Err Then
WScript.Echo Err.Description & " [0x" & Hex(Err.Number) & "]"
End If
On Error Goto 0
If I understood your question correctly, error handling should not be required for what you're trying to do. To make sure that a folder exists before doing something with it, you can simply use the FolderExists method:
If fso.FolderExists("C:\some\folder") Then
'do stuff
End If
However, if for some reason you must use error handling, it can be enabled with the statement On Error Resume Next and disabled with the statement On Error Goto 0. While error handling is enabled you can detect errors by checking the state of the Err object.
A very simple error handling routine might look like this:
On Error Resume Next
f.Copy fso.BuildPath(dst, newname), True
If Err Then
WScript.Echo Err.Description & " [0x" & Hex(Err.Number) & "]"
End If
On Error Goto 0
Error handling suppresses all runtime error messages, so you should keep it as local as possible. Having error handling enabled on a broader scope bears the risk of errors going unnoticed, causing unexpected/undesired behavior for instance due to variables being not initialized or retaining an obsolete value.
If you have several subsequent statements that could fail make sure you add error handling routines for each and clear the Err object after each statement:
On Error Resume Next
Set wmi = GetObject("winmgmts://./root/cimv2")
If Err Then
WScript.Echo Err.Description & " [0x" & Hex(Err.Number) & "]"
End If
Err.Clear
Set proc = wmi.ExecQuery("SELECT * FROM Win32_Process")
If Err Then
WScript.Echo Err.Description & " [0x" & Hex(Err.Number) & "]"
End If
Err.Clear
'...
On Error Goto 0

Get a VBS file to scan computer for a file

This is my first post, but I have been programming for a long time now
I just want to ask a quick question and the title explains it all. I want my VBS to run a file, but I dont want it to search just for a specific directory, I want it to just find the file if you know what I mean, because if I gave the script to anyone else, this file could be ANYWHERE on their computer.
This is the current couple of important lines that I am using for running files:
set wshshell = wscript.CreateObject("wscript.shell")
and
wshshell.run <program directory here>
You need a recursive function like this one searching for shortcuts.
Sub GenerateHotkeyInFolder(Fldr)
on error resume next
set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set FldrItems=Fldr.Items
For Each oFile in FldrItems
With oFile
If .IsFileSystem = true And .IsLink = true And .Type <> "Shortcut to MS-DOS Program" then
set lnk = WshShell.CreateShortcut(oFile.Path)
If lnk.hotkey <> "" then
Set fsop = fso.GetFile(.Path)
LnkName = "<b>" & fso.GetBaseName(fso.GetFile(.Path)) & "</b><br>" & fsop.ParentFolder.path & "\" & fso.GetBaseName(fso.GetFile(.Path)) & "." & fso.GetExtensionName(fso.GetFile(.Path))
TableVar = TableVar & "<tr><td><b>" & lnk.hotkey & "</b></td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.fullname & Chr(34) & ")'>" & lnkname & "</a>" & "</td><td><a class=TblURL onmouseover='MakeRed()' onmouseout='MakeBlack()' onclick='FindShortcut(" & Chr(34) & lnk.targetpath & Chr(34) & ")'>" & lnk.targetpath & "</a></td></tr>" & vbcrlf
End If
ElseIf .IsFileSystem = true And .IsFolder = true then
GenerateHotkeyInFolder(.GetFolder)
End If
End With
Next
End Sub

VBScript Environment variables

I have a question regarding how I should go about fixing an error that I am seeing when running my script. I am pretty sure it has to do with the way in which I am using the %COMPUTERNAME% environment variable.
What my script does is it zips up some files locally, then copies them using robocopy to a mounted or shared drive, then checks to see if the file sizes are the same, and if they are then it deletes the files on the original computer. If any step in the process produces an error it exits the script.
Now the script works perfectly fine if I do not add in the "%COMPUTERNAME%" to the final destination path. (Where the zipped files will eventually be) I need the zipped files to be placed into their own folders with the name of the host from which it originated, because this script will be run on many different machines all going to the same location.
So basically it needs to look something like this:
E:\LocalHostName\TestZip.zip
Now the script will build the folder just fine when the zipped files are being copied over, the problem occurs once the file size check starts. I am getting the error of "File not found" for the line "FileToBeCompared2". I understand why the error is being produced, because it is not recogizing the %COMPUTERNAME% environment variable, but I do not know how to go about addressing this issue.
I am also going to try to add in some functionality where if an error occurs a text file with something like "An error occured during the script" is produced in the output folder.
Thank you for all your help in advance. The script is found below:
'-------------------------------------------------------------------------------------------
'This script is used to zip files locally, copy them to a new location, verify that the
'files were copied correctly, and then delete the files from the original source.
'In it's current state it is being used as a means to zip event files and move them
'to a central location.
'Run with administrator priveleges.
'-----------------------------------------------------------------------------------------------------
Option Explicit
Dim sDirectoryPath, sLocalDestinationPath, sFinalDestinationPath, sOutputFilename, Shell, sFileExt, sFilePrefix
Set Shell = WScript.CreateObject("WScript.Shell")
'Specify Directory Path where files to be zipped are located
'Specify local destination for zipped files
'Specify final destination path for zippped files
'Specify file extension name to look for
'Specify prefix of filename to look for
sDirectoryPath = "C:\Testscripts\"
sLocalDestinationPath = "C:\ScriptOutput\"
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"
sFileExt = ".evtx"
sFilePrefix = "Archive*"
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%") 'Environment variables needed for grabbing hostname
Dim ZipCommand, RobocopyCommand, RunCommand, filesys, filetext
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2) 'Date String
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2) 'Time String
Dim FullFileName
FullFileName = sOutputFilename & "-" & dateStr & "-" & timeStr & ".zip "
'Following command runs 7-zip and grabs the files to be zipped from your set sDirectoryPath, zips them into set sLocalDestinationPath
'and names the file with the localhost name and date/time
ZipCommand = """C:\Program Files\7-zip\7z.exe"" a " & sLocalDestinationPath & FullFileName & sDirectoryPath & sFilePrefix & sFileExt
RunCommand = Shell.Run(ZipCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occurred during the zip process, re-run Script." WScript.Quit
end if
Wscript.Sleep 2000
'The following command creates a folder named after the host computer where the files are being copied from
Dim newfolder, newfolderpath, filesys2
newfolderpath = "E:\CopyTestFolder\" & sOutputFilename & "\"
set filesys2 = CreateObject("Scripting.FileSystemObject")
If Not filesys2.FolderExists(newfolderpath) Then
Set newfolder = filesys2.CreateFolder(newfolderpath)
End If
'Following command runs Robocopy from command line, moves files from your set sLocalDestinationPath to your set sFinalDestinationPath
WScript.Echo "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RobocopyCommand = "Robocopy.exe " & sLocalDestinationPath & " " & sFinalDestinationPath
RunCommand = Shell.Run(RobocopyCommand,0,true)
if err.Number <> 0 then
WScript.Echo "An error has occured copying the files, re-run Script."
WScript.Quit
end if
Dim fso, FileToBeCompared1, FileToBeCompared2
Set fso = CreateObject("Scripting.FileSystemObject")
'Setting the Local file to be compared
Set FileToBeCompared1 = fso.GetFile(sLocalDestinationPath & FullFileName)
WScript.echo sFinalDestinationPath & FullFileName
'Setting the file copied to final destination to be compared
Set FileToBeCompared2 = fso.GetFile(sFinalDestinationPath & FullFileName)
If FileToBeCompared1.size = FileToBeCompared2.size then
fso.DeleteFile("C:\Testscripts\Archive*.evtx") 'This will be the path where events are being Archived to. (Non restricted path)
fso.DeleteFolder("C:\ScriptOutput") 'This deletes the archive folder that 7-zip builds each time this script is run
else
WScript.Echo "File sizes do not match, File was not fully copied, Re run script."
WScript.Quit
end if
Because fso.GetFile() will not automatically expand %COMPUTERNAME%, modify sFinalDestinationPath to use sOutputFilename like this:
sOutputFilename = shell.ExpandEnvironmentStrings("%COMPUTERNAME%")
sFinalDestinationPath = "E:\CopyTestFolder\" & sOutputFilename & "\"

VBScript FTP Login with Username and Password

I am trying to update a VBScript (very little experience with this, I do a lot of VB.NET), that reads an FTP directory and moves certain files to a new local directory on a daily basis. I have old code that works on an FTP site that uses anonymous logins, but I now need it to access an FTP site that requires username and password.
Here is my current code -
Sub MoveNSPurolatorFile()
Dim NSPurolatorFTPSite, NSPurolatorMoveFilePath, NSPurolatorFTPFolder, NSPurolatorFTPFileName
Dim folder, files
Dim fso
set fso = CreateObject("Scripting.FileSystemObject")
NSPurolatorFTPSite="\\xxx.xxx.x.xx\"
NSPurolatorMoveFilePath = "F:\TestDirectory"
NSPurolatorFTPFolder = "TestFolder"
NSPurolatorFTPFileName = "MAN0201.CSV"
If InStr(NSPurolatorFTPFileName, "_processed") = 0 and InStr(NSPurolatorFTPFileName, ".CSV") > 0 Then
If fso.FolderExists(NSPurolatorFTPSite & NSPurolatorFTPFolder) Then
If fso.FileExists(NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName) Then
objfile.writeline "NS Purolator File Found: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
fso.copyFile NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName, NSPurolatorMoveFilePath & "\"
Else
objfile.writeline "File does not exist: " & NSPurolatorFTPSite & NSPurolatorFTPFolder & NSPurolatorFTPFileName
End If
End If
End If
Next
End Sub
It says the folder does not exist, but I know it does and when I run this code against an ftp site that does not require username and password it works fine. I guess my question is - How do I pass in the username and password using VBScript to the ftp site before trying to access folders, etc?
Thanks.
This really is an incredibly bad way to do this. You can't just treat folders on a remote FTP site as local folders.
You really should be using InetCtrls.Inet.1
Here's an example I lifted from somewhere else that does not do what you want, but contains all the parts you need - you need to pick it apart to suit your needs.
'Option Explicit
'const progname="FTP upload script by Richard Finegold"
'const url = "ftp://ftp.myftpsite.com"
'const rdir = "mydir"
'const user = "anonymous"
'const pass = "myname#mymailsite.com"
'This is an example of ftp'ing without calling the external "FTP" command
'It uses InetCtrls.Inet.1 instead
'Included is a "hint" for simple downloading
'Sources:
'http://msdn.microsoft.com/library/partbook/ipwvb5/loggingontoftpserver.htm
'http://msdn.microsoft.com/library/partbook/egvb6/addinginternettransfercontrol.htm
'http://cwashington.netreach.net/ - search on "ftp" - inspiration only!
'Insist on arguments
dim objArgs
Set objArgs = Wscript.Arguments
If 0=objArgs.Count Then
MsgBox "No files selected for operation!", vbOkOnly + vbCritical, progname
WScript.Quit
End If
'Force console mode - csforce.vbs (with some reorganization for efficiency)
dim i
if right(ucase(wscript.FullName),11)="WSCRIPT.EXE" then
dim args, y
For i = 0 to objArgs.Count - 1
args = args + " " + objArgs(i)
Next
Set y = WScript.CreateObject("WScript.Shell")
y.Run "cscript.exe " & wscript.ScriptFullName + " " + args, 1
wscript.quit
end if
'Do actual work
dim fso, ftpo
set fso = WScript.CreateObject("Scripting.FileSystemObject")
set ftpo = WScript.CreateObject("InetCtls.Inet.1") 'Msinet.ocx
ftpo.URL = url
ftpo.UserName = user
ftpo.Password = pass
WScript.Echo "Connecting..."
ftpo.Execute , "CD " & rdir
do
' WScript.Echo "."
WScript.Sleep 100 'This can take a while loop while ftpo.StillExecuting
for i = 0 to objArgs.Count - 1
dim sLFile
sLFile = objArgs(i)
if (fso.FileExists(sLFile)) then
WScript.Echo "Uploading " & sLFile & " as " & FSO.GetFileName(sLFile) & " "
ftpo.Execute , "Put " & sLFile & " " & FSO.GetFileName(sLFile)
'ftpo.Execute , "Get " & sRemoteFile & " C:\" & sLFile
do
'WScript.Echo "."
WScript.Sleep 100 'This can take a while
loop while ftpo.StillExecuting
else
MsgBox Chr(34) & sLFile & Chr(34) & " does not exist!", _
vbOkOnly, progname
end if
next
WScript.Echo "Closing"
ftpo.Execute , "Close"
WScript.Echo "Done!"
Here's a pretty nice way to do it - I'm sure this could be improved upon, but I just got it going.. :-)
Dim fso, folder1, folder2, folder2a
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder2a = fso.GetFolder("C:\temp")
ftpFolderString = "ftp://username:password#ftp.ftpsite.com/folderpath"
targetFoldder = "C:\temp"
fileSearchStr = "searchstring"
Dim SH, txtFolderToOpen, thing
Set SH = CreateObject("Shell.Application")
'SH.Open txtFolderToOpen
Set folder1 = SH.NameSpace(ftpFolderString)
Set folder2 = SH.NameSpace(targetFoldder)
For Each item In folder1.items
If InStr(LCase(item.Name),fileSearchStr) > 0 Then
Debug.WriteLine item.Name
folder2.CopyHere item,4
WScript.Sleep(200)
For Each item2 In folder2a.Files
If item2.Name = item.Name Then
While item2.Size < item.Size
WScript.Sleep(200)
Wend
End If
Next
WScript.Sleep(200)
End If
Next
Set SH = Nothing
Debug.WriteLine "Done"
How is the script being run? Manually, automatically? By a service?
Mapped-letter drives are not always available when running as a service.
Experiment with the script to ensure that it even able to see the F:\ drive, and then see what else is visible.
Is the FTP site accessed by a UNC path (looks like it is)? If it is just a standard FTP address then you can incorporate the username / password in the URL e.g. ftp://user:pass#myftpsite.com. If it is a UNC path that you are trying to access using different credentials then the easiest way would probably be to map a drive, do the work and then unmap the drive. 2 different approaches can be found here

Resources