Encoded VBS not working when called from HTA - vbscript

We have an HTA used for automatic log in to the servers using VBS. To maintain security, we wanted to encode the VBS, which had the credentials for logging in to the server. We came across a VBS script that encoded the VBS file when dragged on to it, the output is a VBE file.
Now, when this VBE is called from HTA, it shows and error, which seems like it is not able to read the VBE properly.
Below is how we are linking the VBE to out HTA :
<script language="VBScript" src="hola.vbe" > </script>
Also, below is the code for encoding :
Option Explicit
dim oEncoder, oFilesToEncode, file, sDest
dim sFileOut, oFile, oEncFile, oFSO, i
dim oStream, sSourceFile
set oFilesToEncode = WScript.Arguments
set oEncoder = CreateObject("Scripting.Encoder")
For i = 0 to oFilesToEncode.Count - 1
set oFSO = CreateObject("Scripting.FileSystemObject")
file = oFilesToEncode(i)
set oFile = oFSO.GetFile(file)
Set oStream = oFile.OpenAsTextStream(1)
sSourceFile=oStream.ReadAll
oStream.Close
sDest = oEncoder.EncodeScriptFile(".vbs",sSourceFile,0,"")
sFileOut = Left(file, Len(file) - 3) & "vbe"
Set oEncFile = oFSO.CreateTextFile(sFileOut)
oEncFile.Write sDest
oEncFile.Close
Next
According to my understanding the encoded VBS should work as normal one, not sure why we are fading issue in this case.

In order to use an encoded VBScript, you need to specify the language engine to use with language="VBScript.Encode" rather than just language="VBScript".
Also, be quite wary if you want to use it "To maintain security". The purpose of the script encoder is to deter casual inspection, but it doesn't "encrypt" the code in any conventional sense, and it's not that hard to get the plain script back.

Related

convert outlook msg to html using vbscript

I'm pretty new to vbscript and I'm just writing a simple script that converts an msg file to html. So far I have:
Dim objshell,BaseName,outlookapp,emailPath
Set objshell= CreateObject("scripting.filesystemobject")
Set outlookapp = CreateObject("Outlook.Application")
Set email = outlookapp.CreateItemFromTemplate(emailPath)
BaseName = objshell.GetBaseName(emailPath)
emailPath = "C:\Users\makkerman\Desktop\email folder\test.msg"
email.saveas objshell.GetParentFolderName(emailPath) & BaseName & ".html", olFormatHTML
outlookapp.Quit
However, I get no output (and no errors). Can someone enlighten me? Thanks in advance.
Side note: how would I write this so that my current instance of Outlook doesn't close when I run the script as it currently does?
You are using OlBodyFormat.olFormatHTML (2), but you need OlSaveAsType.olHTML (5).

VB script will not traverse every file in a given folder

I am new to VBscript and am looking to write a simple script that changes a couple cells in a few thousand csv files in a given folder location. I have a good start, and it all seems to be working, except for the fact that when I run the script (from a .bat file that just calls the script) it only changes and moves 3-8 files at a time. The number of files it changes is random, its not like it always changes 5 files or something. I am not sure what is wrong in the code as to why it will not edit and move every single file and only does a couple at a time, here is what I have so far, thanks in advance for any help:
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
Set colFiles = ObjFSO.GetFolder("C:\Users\xxx\BadCSVs").Files
Set xl = CreateObject("Excel.Application")
For Each objFile in colFiles
If LCase(objFSO.GetExtensionName(objFile)) = "csv" Then
Set wb = xl.Workbooks.Open(objFile)
Set sht = xl.ActiveSheet
If(sht.Cells(1,11) <> "") Then
sht.Cells(1,8) = sht.Cells(1,8) & sht.Cells(1,9)
sht.Cells(1,9) = sht.Cells(1,10)
sht.Cells(1,10) = sht.Cells(1,11)
sht.Cells(1,11) = Null
wb.Save
wb.Close True
Else
'if file is opened up and has only 10 columns of data, then it makes no changes, then closes it.
wb.Close
End If
End If
Next
xl.Quit
Your EVIL global
On Error Resume Next
hides errors. Disable/Remove it and test again.
Your
wb.Close SaveChanges=True
passes the boolean result of comparing SaveChanges (undefined/empty) vs. the boolean literal True. Perhaps you copied VBA code
wb.Close SaveChanges:=True
(mark the colon) that is not legal in VBScript?
And
Set xl = CreateObject("Excel.Application")
should be paired with an
xl.Quit
If you invoke Excel in the loop, terminate it there. I would try to start/quit Excel out of the loop, but you should test that approach carefully.

vbscript to save sync issues folder emails to a folder

Background:
I am a sysadmin for several Windows 7 machines. We have switched from an on-premises Exchange server to Office 365 Exchange Online. The computers are using Outlook 2013/2010 to connect to Exchange Online. All the clients are using full cache mode, so there is a complete OST cache file on each computer.
Because of this, there are now the following folders showing in the Folder view of Outlook: Sync Issues, then (subfolders) Conflicts, Local Failures and Server Failures.
I could not find a way to remotely administer or view these messages, so my only option appears to be manually opening each user's Outlook and viewing the folders. I have tried setting up rules to forward any messages that appear in these folders to me, but I could not get them to work on new emails that appear in these folders.
I would like to write a script that will save the email messages in these folders to a network folder where I can view them later. I would also like to have the script run on an input text file of all the computer names on the network, if possible.
I have no script writing background or knowledge. This is what I have pieced together from the web so far:
Dim OL, NmeSpace
Set OL = CreateObject("Outlook.Application")
Set NmeSpace = OL.GetNamespace("MAPI")
Set Inbx = NmeSpace.GetDefaultFolder(olFolderSyncIssues)
Set Fldr = Application.ActiveExplorer.CurrentFolder
DirName = "C:\Emails\"
For Each itm In Fldr.Items
' Save email as a file.
Next
Thanks in advance for any advice you can offer. I am studying scripting but I do not have the knowledge yet to write the script I want.
Here is how you would go about doing that with a vbscript. Right now it only does the oSyncFolder as I left out the other two folders so you could get some practice writing it yourself.
Dim oApp
Dim ns
Dim oSyncFolder
Dim oConflictFolder
Dim oSrvFailuresFolder
Dim dirName
dirName = "PathToFolder\"
Set oApp = CreateObject("Outlook.Application")
Set ns = oApp.GetNamespace("MAPI")
Set oSyncFolder = ns.GetDefaultFolder(20)'olFolderSyncIssues
Set oConflictFolder = ns.GetDefaultFolder(19)'olFolderConflicts
Set oSrvFailuresFolder = ns.GetDefaultFolder(22)'olFolderServerFailures
Dim iCounter
iCounter = oSyncFolder.Items.Count
For iCounter = oSyncFolder.Items.Count To 0 Step -1
Dim oItem
Set oItem = oSyncFolder.Items.Item(iCounter)
oItem.SaveAs dirName & "email" & CStr(iCounter) & ".msg"
'uncomment line below to remove the item after it has been relocated.
'oItem.Delete
Next
Set oSyncFolder = Nothing
Set oConflictFolder = Nothing
Set oSrvFailuresFolder = Nothing
Set oApp = Nothing
msgbox "Finished"

How to close an application when vbscript crashes

I'm using VBscript to open Microsoft Excel and convert xls documents to csv.
Here is a quick example that takes an argument and converts the first page
Dim oExcel
Dim oBook
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs "out.csv", 6
oBook.Close False
oExcel.Quit
If everything works, that's great. But when the script crashes before it can close excel, the process continues to stay around and lock the file until I manually kill the process.
How can I make sure that I perform any clean up routines even when the script fails?
As the question is/was? about closing Excel reliably when the VBScript used to automate it crashes:
If you write
Set oExcel = CreateObject("Excel.Application")
you create a 'simple' variable. VBScript may decrement a ref counter when the variable goes out of scope, but it certainly won't .Quit Excel for you.
If you want a feature like atexit calls or exception handling in VBScript, you'll have to write a class that 'does what I mean' in its Class_Terminate Sub. A simple example:
Option Explicit
Class cExcelWrapper
Private m_oExcel
Public Sub Class_Initialize()
Set m_oExcel = CreateObject("Excel.Application")
End Sub
Public Sub Class_Terminate()
m_oExcel.Quit
End Sub
Public Default Property Get Obj()
Set Obj = m_oExcel
End Property
End Class
Dim oExcel : Set oExcel = New cExcelWrapper
Dim oWBook : Set oWBook = oExcel.Obj.WorkBooks.Add()
oExcel.Obj.Visible = True
oExcel.Obj.DisplayAlerts = False
oWBook.Sheets(1).Cells(1,1) = "Div by Zero"
WScript.Echo "Check TaskManager & Enter!"
WScript.StdIn.ReadLine
WScript.Echo 1 / 0
(meant to be started with "cscript 20381749.vbs")
If you run this script with an open Taskmanager, you'll see Excel popup in the processes list (and on the screen, because of .Visible). If you then hit Enter, the script will abort with an "Division by Zero" error and the Excel process will vanish from the Processes list.
If you remove the .DisplayAlerts setting, Excel will ask you whether to save your work or not - proving thereby that the .Quit from the Class_Terminate() Sub really kicks Excel into byebye mode.
The class needs further work (basic settings, common actions (save?) before .Quit, perhaps a guard against misuse (Set oExcel = Nothing or other cargo cult crap), th .Obj addition isn't nice, and it won't help you if you kill your .vbs in a debugger, but for standard scenarios you won't see Excel zombies anymore.
Add "On Error Goto ErrorHandler" at the top of your script, and at the bottom of it, add "ErrorHandler:". Underneath the ErrorHandler label add code to manage the situation depending on the Err.Number
See Err object on MSDN.
You can also use "On Error Resume Next". Here is an example.
EDIT: My bad. "Goto" does not exist in VBS. The answer below is probably a much tidier approach.

VB script: Message while Unzipping a file

I am using the below vb script to un-zip the files, so while un-zipping is going on, i am seeing a pop up messgae(Copying/extracting), is there any way to get rid of popup message?
FileToGetUnZipped = "InstallDir\UI_Files.zip"
DestPathForUnzippedFile = "InstallDir\system"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(DestPathForUnzippedFile) Then
objFSO.CreateFolder(DestPathForUnzippedFile)
End If
UnZipFile FileToGetUnZipped, DestPathForUnzippedFile
Sub UnZipFile(strArchive, DestPathForUnzippedFile)
Set objApp = CreateObject( "Shell.Application" )
Set objArchive = objApp.NameSpace(strArchive).Items()
Set objDest = objApp.NameSpace(DestPathForUnzippedFile)
objDest.CopyHere objArchive
End Sub
The CopyHere method takes a second argument which can be a combination of various options, including
(4)
Do not display a progress dialog box.
However, I have not had much success on getting many of these options to work reliably - I think it varies by Windows version as much as anything else.
As a side note, I think you may have issues with the CopyHere method being asynchronous - your script may complete before CopyHere does, which may kill the copying process.

Resources