I am wondering is there a way to handle the whole process with VBscript? I have an M-Files and in VBA I am able to select the reference
After that I can use M-Files API commands to execute the code.
Dim oVaultConnections As MFilesAPI.VaultConnections
Dim oDocumentCollectionOVAP As New MFilesAPI.ObjectVersionAndProperties
Dim oOldDocumentOVAP As New MFilesAPI.ObjectVersionAndProperties
Dim oMFClientApp As New MFilesAPI.MFilesClientApplication
On Error Resume Next
Set oVault = oMFClientApp.BindToVault(szVaultName, 0, True, True)
If Err.Number <> 0 Then
' Error
Err.Number = 0
Set oVault = oMFClientApp.BindToVault(oMFClientApp.GetVaultConnectionsWithGUID(szVaultGUID).Item(1).Name, 0, True, True)
If Err.Number <> 0 Then
MsgBox "Can't connect to M-Files"
End
End If
End If
On Error GoTo 0
On Error GoTo ErrorHandler1
What about VBScript? What if I would like to create VBS file and perform all the actions with VBScript without need of VBA (for Example Excel file)?
In VBScript I have to get all objects by something like:
Set MFiles = CreateObject("Scripting.MFiles")
Is it possible somehow to get it by location of dll? What if my version will change from 19.9.8227.13? Path will be different?
Related
I am creating a library using vbscript and using scriptcontrol object to call these routines from vba. I am trying to create a recordset as a routine with the given sql as parameter as below
sub GetData(sql, byref retrst)
stADO = "Provider=SQLOLEDB.1;Persist Security Info=False;Initial
Catalog=CCMSProd;Data Source=sv-hfi-ccms;UID=vc;PWD=dw;"
cnconn as adoconnection
Set cnconn = CreateObject("ADODB.Connection")
cnconn.Open stADO
msgbox cnconn.ConnectionString
msgbox cnconn.state
With cnconn
.CommandTimeout = 0
Set retrst = .Execute(sql)
msgbox retrst.recordcount
End With
cnconn.close
end sub
and calling this routine as below
scr.Run "GetConnection", tempload, rst
but my recordset returns as nothing, eventhough the connection and recordset created within vbscript.
I need help in this.
There are quite a few problems with your script. I'm not going to go in to each one but be aware that the recordset open call has more parameters. They aren't required but the defaults are adForwardOnly for the cursor type, and adLockReadOnly for locking. Using the defaults will not enable you to get a record count from the recordset so the code I provide just shows the value of the first record in the recordset to indicate data was retrieved.
https://support.microsoft.com/en-us/help/272067/how-to-get-a-record-count-from-a-sql-server-ce-recordset
The code below works but you'll need to modify it for your usage.
Batch file to run the script:
GetRecordset.bat
cscript.exe /nologo GetRecordset.vbs
pause
Script to run:
GetRecordset.vbs
Dim objADORecordset
Dim strDBTableName
On Error Resume Next
'*****Modify below to a table name in your database*****
strDBTableName = "SomeDBTableName"
Set objADORecordset = CreateObject("ADODB.Recordset")
If Err.Number = 0 Then
GetRecordset "SELECT * FROM " & strDBTableName, objADORecordset
With objADORecordset
If Not .BOF Then
.MoveFirst
WScript.Echo "Field 0: " & .Fields(0).Value
Else
WScript.Echo "No records in recordset"
End If
End With
Else
WScript.Echo "Unable to create ADO Recordset"
End If
set objADORecordset = Nothing
WScript.Quit
'*********************************************
Sub GetRecordset(astrSQLQuery, aobjRecordset)
Dim strOLEConnect
Dim strUserID
Dim strUserPW
Dim objADOConnection
On Error Resume Next
WScript.Echo "SQLQuery: " & astrSQLQuery
strOLEConnect = "Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=CCMSProd;Data Source=sv-hfi-ccms;UID=vc;PWD=dw;"
strUserID = "vc"
strUserPW = "dw"
Set objADOConnection = CreateObject("ADODB.Connection")
If Err.Number = 0 Then
objADOConnection.Open strOLEConnect, strUserID, strUserPW
If Err.Number = 0 Then
aobjRecordset.Open astrSQLQuery, objADOConnection
If Err.Number <> 0 Then
WScript.Echo "Recordset open failed ERROR=" & Err.Number
End If
Else
WScript.Echo "Connection open failed ERROR=" & Err.Number
End If
Else
WScript.Echo "ADO connection failed ERROR=" & Err.Number
End If
Set objADOConnection = Nothing
End Sub
I left it similar to your code so you can understand it but it should really create and open the ADO connection before the ADORecordset. You would typically open the connection, run all of the required queries and process them before closing the connection. There's no sense in creating a new connection to the same database multiple times for different queries to the same database. It just adds unnecessary overhead. I'll leave it to you to improve the code for your use.
Here is what I am trying to do:
Get a VBScript to run another VBScript.
get the second VBScript to post an error on completion, either 0 if successful or >0 if not back to the original script and then work on conditions Based on the error code returned.
Uninstall 2010 & copy office 2013
'Copy files from a network share to machine
Set FSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo "Starting to uninstall Microsoft Office 2010 from the machine"
FSO.CopyFile "\\data01\Tools\WSM\Copy_2013.vbs", "C:\temp\Copy_2013.vbs"
FSO.CopyFile "\\data01\Tools\WSM\OffScrub10.vbs", "C:\Temp\OffScrub10.vbs"
FSO.CopyFile "\\data01\Tools\WSM\DeleteOffice13Package.vbs", "C:\temp\DeleteOffice13Package.vbs"
'Wait to execute rest of script where copied filed need to be in location
WScript.Sleep 5000
'Executes Office 2013 copy at the same time, do not wait to continue uninstalling office 2010
Set objShell = WScript.CreateObject("WScript.Shell")
Call objShell.Run("C:\temp\Copy_2013.vbs", 0, False)
WScript.Sleep 3000
'Run VBScript that uninstalls office 2010 (currently set to copy a non existent path for error capture test)
strRemoveOffice10 = "c:\Temp\offscrub10.vbs ALL /Quiet /NoCancel"
Call objShell.Run(strRemoveOffice10, 0, True)
WScript.Echo Err.Number
If Err.Number <> 0 Then WScript.Echo " Microsoft Office 2010 could not be uninstalled. Please uninstall again manually."
If Err.Number = 0 Then WScript.Echo "Microsoft Office 2010 has uninstalled from the machine"
Set objFileSys = Nothing
WScript.Quit
OffScrub10.vbs
Dim objFileSys
Set objFileSys = CreateObject("Scripting.FileSystemObject")
objFileSys.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
On Error Resume Next
If Err.Number <> 0 WScript.Quit Err
To enable error handling you need to put On Error Resume Next before the statement that may cause an error. Then you can return a status code like this:
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
WScript.Quit Err.Number
However, since you said you want a return value >0 in case of an error and Err.Number is an unsigned integer that might be interpreted as a positive or negative value depending on its actual value, something like this might be a better choice:
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
If Err Then WScript.Quit 1
WScript.Quit 0 'can be omitted, because it's the default
To check the returned value in the calling script you need to capture it in a variable. When using the Call statement like you do in your first script the return value is simply discarded. VBScript does not put return values of external commands in the Err object. You may also want to make sure that your script is being run with cscript.exe to avoid messages/popups blocking execution.
strRemoveOffice10 = "cscript.exe c:\Temp\offscrub10.vbs ALL /Quiet /NoCancel"
rc = objShell.Run(strRemoveOffice10, 0, True)
If rc = 0 Then
'OK
Else
'an error occurred
End If
Yes, you can return an exit code from your second script to the first as follows...
WScript.Quit(-1)
Where -1 is your exit code of choice.
Option Explicit
If WScript.Arguments.Count = 0 Then
' If we don't have any arguments, call ourselves to retrieve
' the exit code. It will be returned by the call to the
' Run method
Dim returnCode
returnCode = WScript.CreateObject("WScript.Shell").Run ( _
Chr(34) & WScript.ScriptFullName & Chr(34) & " myArgument " _
, 0 _
, True _
)
' Note ^ the "True"
' We need to wait for the "subprocess" to end to retrieve the exit code
Call WScript.Echo(CStr( returnCode ))
Else
' We have arguments, leave current process with exit code
Call WScript.Quit( 1234 )
End If
Quick sample for testing.
There are two elements to consider:
The called subprocess uses the WScript.Quit method to return the process exit code to the caller
The caller must wait for the subprocess to end to retrieve the exit code. The Run method will return the exit code of the subprocess
I am changing product code, upgrade code and product name of MSI by editing MSI database.
With reference :- http://www.codeproject.com/Articles/383481/Editing-an-MSI-Database
I am able to change all parameters above but unable to change Package Code.
Suggest a way to change package code.
Found a way to do it with vbscript, just out of curiosity:
The "property #9" is the package code (revision number).
Set wi = CreateObject("WindowsInstaller.Installer")
Set summary = wi.SummaryInformation("your.msi", 2)
summary.Property(9) = "{PUT-NEW-GUID-HERE}"
summary.Persist
I'm guessing that the requirement here is to install the same MSI multiple times, which means they need to change that set of guids. However the more normal way to solve that problem is with MSINEWINSTANCE.
https://msdn.microsoft.com/en-us/library/aa370326(v=vs.85).aspx
https://msdn.microsoft.com/en-us/library/aa369528(v=vs.85).aspx
so that you are not changing the base MSI file every time.
Why do you even have the need to set the package code?
Its auto generated during each build.
Take a look at the documentation of the Package element:
http://wixtoolset.org/documentation/manual/v3/xsd/wix/package.html
"The package code GUID for a product or merge module. When compiling a product, this attribute should not be set in order to allow the package code to be generated for each build. When compiling a merge module, this attribute must be set to the modularization guid."
I needed it because MSI created cache in respective package code which restricts us to make another instance of application using MSI so I did this by
using (var database = new Database(#"D:\\Nirvana\\WorkingCopy\\trunk\\proj1\\installer.msi", DatabaseOpenMode.Direct))
{
database.SummaryInfo.RevisionNumber = "{" + Guid.NewGuid() + "}";
}
I extended the Nikolay script for generating a random GUID automatically. The script also support drag and drop and be called through arguments (so you can easily automate it through cscript) and it checks if the file is writable before creating Windows Installer object (if the file is locked by some application, like InstEd, it will throw an error).
Set objArgs = Wscript.Arguments
Set objFso = CreateObject("scripting.filesystemobject")
'iterate through all the arguments passed
' https://community.spiceworks.com/scripts/show/1653-drag-drop-vbscript-framework
For i = 0 to objArgs.count
on error resume next
'try and treat the argument like a folder
Set folder = objFso.GetFolder(objArgs(i))
'if we get an error, we know it is a file
If err.number <> 0 then
'this is not a folder, treat as file
ProcessFile(objArgs(i))
Else
'No error? This is a folder, process accordingly
For Each file In folder.Files
ProcessFile(file)
Next
End if
On Error Goto 0
Next
Function ProcessFile(sFilePath)
' http://www.wisesoft.co.uk/scripts/vbscript_file_modified_date.aspx
' Set objFile = objFSO.GetFile(sFilePath)
' MsgBox "Now processing file: " & CDATE( objFile.DateLastModified)
If Not IsWriteAccessible(sFilePath) Then WScript.Echo "Error persisting summary property stream" : Wscript.Quit 2
'Do something with the file here...
' https://stackoverflow.com/questions/31536349/set-package-code-of-msi-using-vbscript
Set installer = CreateObject("WindowsInstaller.Installer")
Set summary = installer.SummaryInformation(sFilePath, 2)
summary.Property(9) = CreateGuid()
summary.Persist
End Function
' https://stackoverflow.com/questions/968756/how-to-generate-a-guid-in-vbscript
Function CreateGuid()
CreateGuid = Left(CreateObject("Scriptlet.TypeLib").Guid,38)
End Function
' https://stackoverflow.com/questions/12300678/how-can-i-determine-if-a-file-is-locked-using-vbs
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
I am writing a VB Script to update some files on the network. Before beginning, I want to know if any of the files are locked. I'd like to do this before I actually do any updates.
I am aware that I can handle the error if the file is locked when I try to replace it, but I really want to know if any files are locked before I start updating any files.
Is there any way to see that a file is locked using VBS (apart from trying to replace it)?
This function determines whether a file of interest can be accessed in 'write' mode. This is not exactly the same as determining whether a file is locked by a process. Still, you may find that it works for your situation. (At least until something better comes along.)
This function will indicate that 'write' access is not possible when a file is locked by another process. However, it cannot distinguish that condition from other conditions that prevent 'write' access. For instance, 'write' access is also not possible if a file has its read-only bit set or possesses restrictive NTFS permissions. All of these conditions will result in 'permission denied' when a 'write' access attempt is made.
Also note that if a file is locked by another process, the answer returned by this function is reliable only at the moment the function is executed. So, concurrency problems are possible.
An exception is thrown if any of these conditions are found: 'file not found', 'path not found', or 'illegal file name' ('bad file name or number').
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
The script below tries to write to a file for 30 seconds and gives up after that. I needed this when all our users had to click on a script. Chances are that multiple users try to write at the same time. OpenCSV() tries to open the file 30 times with a delay of 1 second in between.
Const ForAppending = 8
currentDate = Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now)
filepath = "\\network\path\file.csv"
Set oCSV = OpenCSV( filepath )
oCSV.WriteLine( currentDate )
oCSV.Close
Function OpenCSV( path )
Set oFS = CreateObject( "Scripting.FileSystemObject" )
For i = 0 To 30
On Error Resume Next
Set oFile = oFS.OpenTextFile( path, ForAppending, True )
If Not Err.Number = 70 Then
Set OpenCSV = oFile
Exit For
End If
On Error Goto 0
Wscript.Sleep 1000
Next
Set oFS = Nothing
Set oFile = Nothing
If Err.Number = 70 Then
MsgBox "File " & filepath & " is locked and timeout was exceeded.", vbCritical
WScript.Quit
End If
End Function
Or, more simply:
Assuming you already have a variable in your VBS named FileName, which contains the full filepath you want to test:
Dim oFso, oFile
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFile = oFso.OpenTextFile(FileName, 8, True)
If Err.Number = 0 Then oFile.Close
Line 3 tries to open the file you want to test with append permissions enabled. e.g. it attempts to open the file with a write lock.
If opening the file with a write lock generates an error, then your VBS will error on the third line and not continue. At that point your error handling from wherever you called the VBS should kick in. The error message will be "Permission Denied" if you couldn't get a write lock.
If opening the file with a lock doesn't result in an error, then line 4 closes it again. You can now open the file or do whatever you want with it, confident that it doesn't have a write lock on it.
I am a newbie to VBS scripting. I am getting above error on line 54, character 5 in script below. This error says "Object doesn't support this property or method: 'MimeMapArray'".
And line it is referring to is:
MimeMapArray(i) = CreateObject("MimeMap")
Can u tell me what I am doing wrong? Here is the script in its entirety. Note, I am trying to run this on an XP OS by double-clicking this VBS file.
' This script adds the necessary Windows Presentation Foundation MIME types
' to an IIS Server.
' To use this script, just double-click or execute it from a command line.
' Running this script multiple times results in multiple entries in the IIS MimeMap.
' Set the MIME types to be added
Dim MimeMapObj
Dim MimeMapArray
Dim WshShell
Dim oExec
Const ADS_PROPERTY_UPDATE = 2
Dim MimeTypesToAddArray
MimeTypesToAddArray = Array(".manifest", "application/manifest", ".xaml", _
"application/xaml+xml", ".application", "application/x-ms-application", _
".deploy", "application/octet-stream", ".xbap", "application/x-ms-xbap", _
".xps", "application/vnd.ms-xpsdocument")
' Get the mimemap object
Set MimeMapObj = GetObject("IIS://LocalHost/MimeMap")
' Call AddMimeType for every pair of extension/MIME type
For counter = 0 to UBound(MimeTypesToAddArray) Step 2
AddMimeType MimeTypesToAddArray(counter), MimeTypesToAddArray(counter+1)
Next
' Create a Shell object
Set WshShell = CreateObject("WScript.Shell")
' Stop and Start the IIS Service
Set oExec = WshShell.Exec("net stop w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = WshShell.Exec("net start w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = Nothing
' Report status to user
WScript.Echo "Windows Presentation Foundation MIME types have been registered."
' AddMimeType Sub
Sub AddMimeType(ByVal Ext, ByVal MType)
' Get the mappings from the MimeMap property.
MimeMapArray = MimeMapObj.GetEx("MimeMap")
' Add a new mapping.
i = UBound(MimeMapArray) + 1
ReDim Preserve MimeMapArray(i)
MimeMapArray(i) = CreateObject("MimeMap")
MimeMapArray(i).Extension = Ext
MimeMapArray(i).MimeType = MType
MimeMapObj.PutEx ADS_PROPERTY_UPDATE, "MimeMap", MimeMapArray
MimeMapObj.SetInfo()
End Sub
The first thing I can suggest is use cscript to execute. You can get more information that won't go away like with a message box.
Open a command prompt (go to start,
run, type CMD).
Go to the location where your script
is and type the following:
cscript scriptname.vbs
...where scriptname.vbs is the name of your script.
Second, you appear to be missing the "set" in front of your createobject line. Have a look here for reference.
That line should look like:
set MimeMapArray(i) = CreateObject("MimeMap")