Visio: DOS Sharing violation (Error 1532) - vba

So I'm really confused right now. Out of the blue my code gets me the error "DOS Sharing violation".
It's weird because, it says that is trying to save my document, but I just want to open it.
This is my Code:
Public Sub ReadActivity()
Dim vsoDocument As Visio.Document
Dim vsoPage As Visio.Page
Set vsoDocument = Documents.Open("C:\Users\Philip\Dropbox\Test\Aktivität0.vsdx")
Set vsoPage = vsoDocument.Pages(1)
SvgExport (ActiveDocument.path & "\files_and_images\" & Left(ActiveDocument.name, (InStrRev(ActiveDocument.name, ".", -1, vbTextCompare) - 1)) & ".svg")
CreateCodeActivity
vsoDocument.Close
End Sub
So as you might see the code is simple nothing special is going on.
Before calling the method I'm using this for encoding my textfile: VBA : save a file with UTF-8 without BOM
And two things are very weird. First of all, I used this method two days in a row for coding the method "CreateCodeActivity" and I didn't have any problems. And second, if I call the method let's say three times, on the third time everything works perfectly...
Where might be the problem?

Thank you #Shmukko for the tip, it is really the windows defender that gives me the error.
For Windows 10 the solution is: Go to Settings and select Update & security -> Windows Defender. Select Exclude a file extension and enter the file type for Visio.
That's it.

Related

ActiveDocument.SaveAs2 saving the document but can not ever open the document once saved (only some computer models)

Currently I have a document template with macros endabled .dotm. The macro has a commandbutton in there that triggers the SaveAs2 object twice formatted as below.
Public Sub FileSaveAs()
Dim dlg As Dialog
Dim strSaveFolder
strSaveFolder = Application.Options.DefaultFilePath(wdDocumentsPath)
Application.Options.DefaultFilePath(wdDocumentsPath) = ActiveDocument.AttachedTemplate.Path
ActiveDocument.SaveAs2 (ActiveDocument.AttachedTemplate.Path & " UsersName" & " FORM234" & Format(Now(), "DD-MMM-YYYY hh mm ss AMPM") & ".docm")
End
Second Save as
Public Sub SuperSave()
Dim dlg As Dialog
Dim strSaveFolder
strSaveFolder = "I:\Form Storage\CoCopy\"
ActiveDocument.SaveAs2 (strSaveFolder & "UserName" & "Form234" & Format(Now(), "DD-MMM-YYYY hh mm ss AMPM") & ".docm")
End Sub
Now here is the interesting part that has me stumped now for about a week now. This code works but only on some computers. Older models it doesn't work on for some reason. It doesn't matter Windows 10 or Windows 7 or Version of Office itself. It doesn't work on computers that are older in models like a HP EliteDesk 1 or HP EliteDesk 2. The 1 won't work but 2 will.
I have never heard of the vba macro being affected by the model of the computer version of OS yes version of Word ofcourse but never version of model. I have googled left and right and went to documentation from 2010 (including microsoft's killing activex issue of 2014 which I already ruled out)
This is how blank I mean doesn't even open the white page underneath.
Any ideas? Or have you heard of some computer models not running vba code but having the same OS and same version of Office?
Justin, I figured it out by chance were you trying to save a dotm as a docm. If the macro tries to save the dotm as a docm the formatting for the data is two separate instances. I followed through with this and noticed it in a test I ran on the document when right clicked and opened and got the same result try saving the template as a docm document instead this should resolve your issue.
Cindy, Justin is right it does yield a proper path and handles correctly in the VBA console without the slash. In the first sub he seems to only be after the path for the folder and is saving on the next parent folder outside of the folder containing the template macro. I have seen this work elsewhere why it is not working on specific models has me at a loss.
The second seems to target the location more specifically than the second which makes since if the folder is targeting a co-worker. I am currently trying to recreate the issue but having no luck your code works perfectly on my two systems I have running, both are rather new.
Try changing the wdsaveformat to match an extension type the formatting might be handled differently on newer models (unlikely but worth a shot)
Or rewrite the vba and document on the older afflicted models to see if they handle the setup and formatting differently

Word automation failing on server, but dev station works great

I am automating a oft-used paper form by querying the user on a web page, then modifying a base Word document and feeding that modified doc file to the user's browser for hand-off to Word.
The code is Visual Basic, and I am using the Microsoft.Office.Interop module to manipulate the document by manipulating Word. Works fine on the development system (Visual Studio 2015) but not on the production server (IIS 8.5).
Both the Documents.Open() call and the doc.SaveAs() call fail with Message="Command failed" Source="Microsoft Word" HResult=0x800A1066
Things I've tried:
Added debugging out the whazoo: Single-stepping is not an option on the production machine, so I pinpointed the problem lines with debug output.
Googled and found that this problem has been reported as early as 2007, but no viable solutions were reported.
A couple sites mentioned timing issues, so I added several pauses and retries -- none helped.
Some mentioned privileging, so I tried changing file permissions & application pool users -- neither helped.
Enhanced my exception handling reports to show more details and include all inner exceptions. That yielded the magic number 800A1066 which led to many more google hits, but no answers.
Added fall-back code: if you can't open the main document, create a simple one. That's when I found the SaveAs() call also failing.
Dropped back to the development system several times to confirm that yes, the code does still work properly in the right environment.
Greatly condensed sample code does not include fallback logic. My Word document has a number of fields whose names match the XML tokens passed as parameters into this function. saveFields() is an array of those names.
Dim oWord As Word.Application
Dim oDoc As Word.Document
oWord = CreateObject("Word.Application")
oWord.Visible = True
oDoc = oWord.Documents.Open(docName)
Dim ev As String
For i = 0 To saveFields.Length - 1
Try
ev = dataXD.Elements(saveFields(i))(0).Value
Catch
ev = Nothing
End Try
If ev IsNot Nothing Then
Try
Dim field = oDoc.FormFields(saveFields(i))
If field IsNot Nothing Then
If field.Type = Word.WdFieldType.wdFieldFormTextInput Then
field.Result = ev
End If
End If
Catch e As Exception
ErrorOut("Caught exception! " & e.Message)
End Try
End If
Next
...
oDoc.SaveAs2(localDir & filename)
oDoc.Close()
oWord.Quit(0, 0, 0)
The code should generate a modified form (fields filled in with data from the parameters); instead it fails to open, and the fallback code fails to save the new document.
On my dev system the document gets modified as it should, and if I break at the right place and change the right variable, the fallback code runs and generates the alternate document successfully -- but on the production server both paths fail with the same error.
Barring any better answers here, my next steps are to examine and use OpenXML and/or DocX, but making a few changes to the existing code is far preferable to picking a new tool and starting over from scratch.
Unfortunately, Lex Li was absolutely correct, and of course, the link to the reason why is posted on a site my company considers off limits, thus never showed up in my google searches prior to coding this out.
None of the tools I tried were able to handle the form I was trying to automate either -- I needed to fill in named fields and check/uncheck checkboxes, abilities which seemed beyond (or terribly convoluted in) the tools I evaluated ...
Eventually I dug into the document.xml format myself; I developed a function to modify the XML to check a named checkbox, and manipulated the raw document.xml to replace text fields with *-delimited token names. This reduced all of the necessary changes to simple string manipulation -- the rest was trivial.
The tool is 100% home-grown, not dependent upon any non-System libraries and works 100% for this particular form. It is not a generic solution by any stretch, and I suspect the document.xml file will need manual changes if and when the document is ever revised.
But for this particular problem -- it is a solution.
This was the closest I got to a complicated part. This function will check (but not uncheck) a named checkbox from a document.xml if the given condition is true.
Private Shared Function markCheckbox(xmlString As String, cbName As String, checkValue As Boolean) As String
markCheckbox = xmlString
If checkValue Then ' Checkbox needs to be checked, proceed
Dim pos As Integer = markCheckbox.IndexOf("<w:ffData><w:name w:val=""" & cbName & """/>")
If pos > -1 Then ' We have a checkbox
Dim endPos As Integer = markCheckbox.IndexOf("</w:ffData>", pos+1)
Dim cbEnd As Integer = markCheckbox.IndexOf("</w:checkBox>", pos+1)
If endPos > cbEnd AndAlso cbEnd > -1 Then ' Have found the appropriate w:ffData element (pos -> endPos) and the included insert point (cbEnd)
markCheckbox = markCheckbox.Substring(0, cbEnd) & "<w:checked/>" & markCheckbox.Substring(cbEnd)
End If
' Any other logic conditions, return the original XML string unmangled.
End If
End If
End Function

Change the path of an Excel file linked to Access 2011 with VBA

I was trying something more fancy and did post on accessforums, where I got got no responses and on programmers access, where I got links to more reading material, but which did not help me - probably due to my lack of VBA expertise.
I have done lots of other programming like PHP and Arduino, but VBA is new for me, although I been watching hours of videos, they don't quite cover what I want to do.
After 4 days of researching an failed attempts, I have simplified my approach and I would appreciate some "real" help with actual code.
Scenario:
I have multiple Excel source file with 9 tabs each.
All the source files are in the same directory, (not in the same directory as the database)
Only one source is ever linked.
Each tab of the source file is a linked table within Access.
Objective:
I wish regularly switch source files.
Method:
I want to replace only the connect file property (i.e. the full file path) for each of the 9 sheets/tabs that use the particular file.
The full path must be "picked up" from my form and applied on an event e.g. on closing of form.
Progress:
I have built a form in which I can enter the file name to use and which calculates the full path to the file in question.
I have a button on the form, which is used to close the form.
Code:
Private Sub Form_Close()
Dim dbs As Database
Dim tdf As TableDef
Dim sfl As String
Dim basePath As String
Dim sName As String
Set dbs = CurrentDb
Set sfl = "SourceData_"
Set sName = "JoeSmith"
Set basePath = "D:\Databases\BOM Consolidator\data_source"
' Loop through all tables in the database.
For Each tdf In dbs.TableDefs
If InStr(10, tdf.Connect, sfl, 1) > 10 Then
tdf.Connect = ";DATABASE=" & basePath & sfl & sName & "\" & dbs
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
End If
End If
Next tdf End Sub
In the above I am entering the path etc directly just to get it working first.
Access froze :(
Help would be appreciated.
Posting this before I try a restart.
After a restart it is not freezing.
It is saying I have a missing object.
The first line is highlighted in yellow, so I assume something must go in the parenthesis, but no idea what.
If it was a function, I would normally put a variable that is not declared inside the function. This being a subroutine, I was not expecting it to ask for something...
Ultimately I will turn it into a function, sothat I can provide the file name.
A clue to what is needed on the first line please...?
Oh also I am using "Code Builder" - is that the correct option to use with closing a form?

Access autocad object properties without opening it by VBA

I have been using folder browser for VBA, I could paste the code of it, but bottom line is that I get returned file name as a string.
Is there any way to access drawing properties (i.e number of layouts) without open?
Public Sub TestFileDialog()
dwgname = FileBrowseOpen("C:", "*", ".dwg", 1) 'dwgname is typeof string
End Sub
Its only the first step (use of FileBrowseOpen function is shown, but also i can use FolderBrowse and collect all .dwg inside of folder),actually i had in mind to batch export all layouts of selected .dwgs to currenty open one. Is there any chance for that?
To effectively read a .dwg file you'll need to open AutoCAD, otherwise the information is not accessible. Some properties may be, such as author, but not number of layouts...
But you can use AutoCAD Console (accoreconsole.exe) to run a headless AutoCAD and use APIs to read any information you need. This is really fast for reading lot's of files and the user will not see it running (but it needs to be installed anyway).
http://aucache.autodesk.com/au2012/sessionsFiles/3338/3323/handout_3338_CP3338-Handout.pdf
you could stay in VBA and use ObjectDBX
it leads to a very similar approach as accoreconsole.exe on in .NET does, i.e you won't see any drawing open in UI since it works on the database itself
It requires adding library reference (Tools->References) to "AutoCAD/ObjectDBX Common XX.Y Type Library", where "XX.Y" is "19.0" for AutoCAD 2014
a minimal functioning code is
Sub main()
Dim myAxDbDoc As AxDbDocument
Dim FullFileName As String
FullFileName = "C:\..\mydrawing.dwg" '<== put here the full name of the file to be opened
Set myAxDbDoc = AxDb_SetDrawing(FullFileName)
MsgBox myAxDbDoc.Layers.Count
End Sub
Function AxDb_SetDrawing(FullFileName As String) As AxDbDocument
Dim DBXDoc As AxDbDocument
Set DBXDoc = Application.GetInterfaceObject("ObjectDBX.AxDbDocument.19") '<== place correct AutoCAD version numeber ("19" works for AutoCAD 2014)
On Error Resume Next
DBXDoc.Open FullFileName
If Err <> 0 Then
MsgBox "Couldn't open" & vbCrLf & vbCrLf & FullFileName, vbOKOnly + vbCritical, "AxDB_SetDrawing"
Else
Set AxDb_SetDrawing = DBXDoc
End If
On Error GoTo 0
End Function
Still, you must have one AutoCAD session running from which make this sub run! But you should have it since talked about "currently open" drawing

VBA File Dialog .FileName removing .1 from end of file name

I am using visual basic to write a Macro for Autodesk Inventor. I created a macro that calls a file dialog, see code below. Everything works fine except when a user puts a file name in with a period and a number greater than zero following it.
For example, if a user puts testfile.test in the box and hits ok. When I ask for what they put in there using .FileName, I get "testfile.test". Just like I should.
However, if the user puts testfile.1 or testfile.10 or testfile.1mdksj or anything as long as a number greater than zero directly follows the period I get back "testfile". For some reason, everything after the period and the period gets removed.
What is the reason for this? Is this a bug in visual basic or am I doing something wrong?
'Set up the file dialog
Dim oFileDlg As FileDialog
' Create a new FileDialog object.
Call ThisApplication.CreateFileDialog(oFileDlg)
'Define the filter to select part and assembly files or any file.
oFileDlg.Filter = "All Files (*.*)|*.*"
'Define the part and assembly files filter to be the default filter.
oFileDlg.FilterIndex = 1
'Set the title for the dialog.
oFileDlg.DialogTitle = "Save File As"
'Tell the dialog box to throw up and error when cancel is hit by user
oFileDlg.CancelError = True
'Show the file dialog
On Error Resume Next
oFileDlg.ShowSave
'save the user specified file
Dim newFileName As String
newFileName = oFileDlg.FileName
UPDATE:
I ended up doing the following "hack" to make things still work while dealing with a period:
oFileDlg.fileName = sFname & "."
oFileDlg.ShowSave
fullName = Left$(oFileDlg.fileName, Len(oFileDlg.fileName) - 1)
That worked fine for quite a while on Windows 7 and then Windows 10. Unfortunately, the Windows 10 Creative update seems to have changed how the file dialog works. With the above code, fullName would come back blank if there were no periods in the name and would truncate everything from the FIRST period from the left if there was a period in the name.
I'm not really sure what changed in Windows 10, but it pretty much destroyed my hack. Windows 7 still works fine and Windows 10 before the creative update works. I ended up doing the following to make everything work again in the version of Windows I mentioned above.
oFileDlg.fileName = sFname & ".00"
oFileDlg.ShowSave
fullName = Left$(oFileDlg.fileName, Len(oFileDlg.fileName) - 3)
This is a VB property, but it may extend to VBA as well. Have you tried setting the save settings to support multidotted extensions? Try something like this:
SupportMultiDottedExtensions = True
This setting is intended permit the use dotted extensions - meaning the use of periods in the file name. See this MSDN reference for documentation and information: http://msdn.microsoft.com/en-us/library/system.windows.forms.filedialog.supportmultidottedextensions.aspx#Y129
This SO article may also shed further light: SaveAs Dialog with a period in the filename does not return extension
EDIT
After checking the autodesk documentation - a difficult and unpleasant task, in my opinion - there does indeed appear to be no support for MultidottedExtensions. I did, however, find a function on VBAExpress that I have very closely adapted. The function can be used to filter strings with contain unacceptable characters. Jimmy Pena's blog has an excellent function for just such a purpose: http://www.jpsoftwaretech.com/excel-vba/validate-filenames/. I have only substantively added a period and a replace to the code:
'A function for filtering strings, with a focus on filenames.
Function FilterFileNameString(stringToScrub As String) As String
'Filters a filename string - or any string for that matter.
Dim FilteredString As String
'A highly nested replace function.
FilteredString = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(stringToScrub, ".","|", ""), ">", ""), "<", ""), Chr(34), ""), "?", ""), "*", ""), ":", ""), "/", ""), "\", "")
'Returns filtered string.
FilterFileNameString = FilteredString
End Function
Jimmy Pena's blog also contains a recursive version as well, although he does not recommend it.
You can filter any strings to be used as filenames with another character - a space in this case. You could use an underscore, however, or any other character you deemed pleasant.
In general, if you are trying to use periods for versioning or a similar purpose, and inventor will not let you, I would strongly advise going to another character or set of characters that can provide such an indication, such an underscore "_", a numbering system, "001", "002", a lettering system, "AAA", "AAB", or whatever makes sense for your focus.
If you are just making the application user-friendly, I would suggest filtering the strings entered before saving them in the desired filetype, and separate the filtering of the strings from the save dialog if the period filtering gives you grief. It may add an extra step, but it may be the best and easiest way to filter out pesky invalid characters without creating unnecessary extra hassles for your users.
~JOL