I am trying to create a vba code that extracts the name of files saved into a .pset. Is there anyway to open a .pset with out opening microstation. When i open with notepad its all in garbled coding language that i can not utilize the information.
Thanks!
Hi Emily (and Tom F),Here is the procedure (sorry for the formatting). To piggyback off what Tom said:
From here the rest is up to you. I like to paste this column into the spreadsheet I used to create the PSET; this allows me to check where the missing file(s) from the PSET are.
Enjoy,
LOR
LOR,
Man, that is some impressive reverse engineering. That's going into the toolbox.
Tom F.
Shoot--I forgot one thing:I explored, and maybe continue to explore, creating ONE pset for EACH dgn, with the hopes--according to a CR filed a few years ago--that a tool to stitch PSETs together would exist by now (it doesn't, AFAIK). This sort-of solves The Problem by off-loading the PSETs to the individual user(s) (since they need to make check-prints).
Why ONE pset for EACH dgn?
Aside from the missing stitching tool, the biggest problem here is:
This is tough to swallow for most project teams. Well, I guess Milton Friedman was right: there are no free lunches...
FYI - I found that the extracted zip folder contains a file named "[Content_Types].xml", which lists an xml file for each pset member in the same order listed in the pset. Extracting the file names can be done simply by reading the first attribute of each xml listed in that "[Content_Types].xml" file.
Sub ExtractFileNames() Dim XDoc As Object Dim XDoc2 As Object Dim xmlpath As String xmlpath = FolderSelectDialog("Select Folder", "C:\") Set XDoc = CreateObject("MSXML2.DOMDocument") XDoc.async = False: XDoc.validateOnParse = False XDoc.Load (xmlpath & "/[Content_Types].xml") 'Get Document Elements Set lists = XDoc.documentElement For Each listnode In lists.childNodes If InStr(1, listnode.Attributes(0).Text, ".xml", vbTextCompare) Then Set XDoc2 = CreateObject("MSXML2.DOMDocument") XDoc2.async = False: XDoc2.validateOnParse = False XDoc2.Load (xmlpath & listnode.Attributes(0).Text) Set lists2 = XDoc2.documentElement If InStr(1, lists2.Text, ".dgn", vbTextCompare) Then WriteToFile2 lists2.childNodes(0).Text End If Set XDoc2 = Nothing End If Next listnode Set XDoc = NothingEnd SubSub WriteToFile2(ExtractedName As String) 'Sub Function used to write substitution strings to text fileDim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")If Not fso.FolderExists("C:\Temp\") Then fso.CreateFolder ("C:\Temp\")End If If Dir("C:\Temp\Extracted.txt") <> "" Then Open "C:\Temp\Extracted.Txt" For Append As #1 Else Open "C:\Temp\Extracted.Txt" For Output As #1 End If Print #1, Chr(34) & ExtractedName & Chr(34) 'Chr(34) adds quotation marks Close #1End Sub
Public Function FolderSelectDialog(sCaption As String, sDefaultFolder As String)Const HWND As Long = 0Const NO_OPTIONS As Long = 0Dim oShell As Object, oFolder As Object, sFileSpec As StringSet oShell = CreateObject("Shell.Application")Set oFolder = oShell.BrowseForFolder(0, sCaption, 0, CStr(sDefaultFolder))If Not oFolder Is Nothing ThensFileSpec = oFolder.Items.Item.PathEnd IfFolderSelectDialog = sFileSpecSet oFolder = NothingSet oShell = NothingEnd Function
Note: VBA References should include Microsoft Scripting Runtime and Microsoft XML
That's helpful, Thanks Juan
Learned something new today! Nice work kids.
Connect r17 10.17.2.61 self-employed-Unpaid Beta tester for Bentley