I have the below For loop. As you can see, I am trying to close the specific file if it is open.
The below set-up asks me whether I want to save the file. How do I close it without saving the file?
I've tried setting DisplayAlerts to False as well as ObjDoc.close False
The error I am getting is 'Property Let procedure not defined and Property Get procedure did not return an object'
Sub MacroExample()
' Define local variables
Dim objVisio
Dim objDoc
Dim blnVisioCreated
' Initialize Vision application reference variable
Set objVisio = Nothing
' Assume Visio is already running, then try and get a reference to it
blnVisioCreated = False
On Error Resume Next
Set objVisio = GetObject(, "Visio.Application")
On Error GoTo 0
' If Visio was not running already load it and remember that we created it
If objVisio Is Nothing Then
Set objVisio = CreateObject("Visio.InvisibleApp")
blnVisioCreated = True
End If
' See if out drawing is already open, if so close it
For Each objDoc In objVisio.Documents
If objDoc.Name = "Drawing1.vsd" Then
'objVisio.DisplayAlerts = False
objDoc.alertrespons = 0
objDoc.Close False
Exit For
End If
Next
Thanks all!
I've used this line before the closing line
objVisio.AlertResponse = vbNo
objDoc.Close
Related
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?
I am trying to open automatically an excel document on a Mac OS X, but it doesn't work. My code is:
Sub Button81_Click()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("/Users/ricardo/Miniman/miniman_uti.docx")
objWord.Visible = True
End Sub
Will the path be wrong? For this path "/Users/ricardo/Miniman/miniman_uti.docx" it opens excel files. Why not word files?
Can someone please help me?
Does this work for you?
sub Test()
dim objdoc as object
with CreateObject("word.application")
set objdoc = .documents.open("path")
end with
end sub
Code to safely open a word doc from a file.
Handles the case where you already have word open.
Dim w As Object
' If word is already open get ahold of the running instance
' Otherwise create a new instance
On Error Resume Next
Set w = GetObject(, "Word.Application")
If w Is Nothing Then Set w = CreateObject("Word.Application")
On Error GoTo 0
' Close all open files and shutdown Word
' Loop through any open documents and close them
Do Until w.Documents.Count = 0
w.Documents(1).Close
Loop
w.Quit False
Set w = Nothing
' Now that all instances of word are closed, open the template
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.application")
wdApp.Visible = True
wdApp.DisplayAlerts = False
Set wdDoc = wdApp.Documents.Open(Filename:="MYPATH")
I have a VB6 application in which I fetch some data from the database.
I am having a problem while closing the created session.
Looks like the session is being retained even after I set the session object to Nothing. Seems like it gets closed only when I close the application.
I am using the following query to check the session in the database.
SELECT * FROM v$session where terminal='VirtualMachineName';
Below is the code,
Dim pCounter As Long, strLoadSQL As String
Dim objCursor As OraDynaset
Dim tmpDBSessobj As OracleInProcServer.OraSession
Dim tmpDBClientobj As OracleInProcServer.OraDatabase
Dim objresetGI As GameInfo
On Error GoTo ErrorHandler
Set tmpDBSessobj = CreateObject("OracleInProcServer.XOraSession")
Set tmpDBClientobj = tmpDBSessobj.OpenDatabase(strDBServiceName, strDBUsernamePassword, ORADB_ORAMODE)
'set autocommit false ---
tmpDBClientobj.AutoCommit = False
'set params
Do Until tmpDBClientobj.Parameters.Count = 0
For pCounter = 0 To tmpDBClientobj.Parameters.Count - 1
tmpDBClientobj.Parameters.Remove pCounter
Next
Loop
'bind
tmpDBClientobj.Parameters.Add "ocursor", Nothing, ORAPARM_OUTPUT
tmpDBClientobj.Parameters(0).serverType = ORATYPE_CURSOR
'declare proc signature
strLoadSQL = "begin resetpackage.getresetID(:ocursor); end;"
'reset this game
tmpDBClientobj.ExecuteSQL (strLoadSQL)
Set objCursor = tmpDBClientobj.Parameters(0).Value
'load the list box
If objCursor.RecordCount > 0 Then
argscollection.Clear
objCursor.MoveFirst
Do Until objCursor.EOF
objresetGI.strGameNo = objCursor.fields(0).Value
objresetGI.strAction = objCursor.fields(1).Value
objresetGI.strProcessInd = objCursor.fields(2).Value
argscollection.Add objresetGI, objCursor.fields(0).Value
objCursor.MoveNext
Loop
End If
Set objCursor = Nothing
tmpDBClientobj.Close
Set tmpDBClientobj = Nothing
Set tmpDBSessobj = Nothing
Any help in this regard will be appreciated.
objCursor should give you the option to use close and not nothing - objCursor.Close
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'm not really a programmer by trade, so forgive me if I'm not aware of any standard debugging tools.
I have what I thought was a very simple VBScript (just a txt file saved with a .vbs extension):
Const wdDoNotSaveChanges = 0
Const wdRevisionsViewFinal = 0
Const wdFormatPDF = 17
Dim arguments
Set arguments = WScript.Arguments
Function DOC2PDF(sDocFile)
Dim fso ' As FileSystemObject
Dim wdo ' As Word.Application
Dim wdoc ' As Word.Document
Dim wdocs ' As Word.Documents
Set fso = CreateObject("Scripting.FileSystemObject")
sDocFile = fso.GetAbsolutePathName(sDocFile)
sPdfFile = fso.GetParentFolderName(sDocFile) + "\" + fso.GetBaseName(sDocFile) + ".pdf"
Set wdo = CreateObject("Word.Application")
Set wdocs = wdo.Documents
Set wdoc = wdocs.Open(sDocFile)
if fso.FileExists(sPdfFile) Then
fso.DeleteFile sPdfFile, True
End If
Set wview = wdoc.ActiveWindow.View
wview.ShowRevisionsAndComments = False
wview.RevisionsView = wdRevisionsViewFinal
wdoc.SaveAs sPdfFile, wdFormatPDF
wdo.Quit wdDoNotSaveChanges
Set fso = Nothing
Set wdo = Nothing
End Function
however, the following line is causing huge grief:
Set wdoc = wdocs.Open(sDocFile)
Sometimes the Word ActiveX object just freezes at this step. I've verified this by some super-simple debugging by putting a WriteLine after each line and seeing where it stops.
Word just sits there consuming 100% CPU, and the script never gets past that step.
How can I go about debugging to find out what the hell is going on with the Word ActiveX object and why it's just hanging and never returning?
Word might be waiting for a prompt from you. I would make Word visible and see if you can visually see what the problem is:
Set wdo = CreateObject("Word.Application")
'if memory serves, this should make Word visible
wdo.Visible = true
Set wdocs = wdo.Documents