3 Replies Latest reply on Jul 5, 2017 6:33 AM by Craig Bill

    Exclude sub-folders....  Via Exclude list.

    Craig Bill

      Good day, excuse my naivety ....


      Running SW 2016 x64 SP5.0


      I am trying to use this fantastic macro from Steve Takata to export all the embedded PDFs from our Workgroup PDM to a local folder.

      The trouble i am having is that it gets to a certain point and pings up this error (typically at the most crucial point):


      I have tried removing files from around the area that it stops with no success.

      I'm therefore wondering if someone could help me exclude this folder, at current the macro excludes root folders but to my knowledge doesn't exclude sub folders.

      This sounds like a simple task as most of the lines are there, but I have little knowledge with API.

      Assuming its this line:

      Function CreateFolderCheckForChild(proj As PDMWProject, previousPath As String)

      but cant figure out how to include the excludeList filter.


      Sub main()

          'Uncomment this line to ignore errors and continue on silently

          'On Error Resume Next

          'Creates a connection object to the WPDM

          Set connection = CreateObject("PDMWorks.PDMWConnection")


          'Define user name, password, and server name or address

          Dim username As String

          username = "********"

          Dim password As String

          password = "********"

          Dim server As String

          server = "*********"


          Dim ret As Long


          'Login to vault using above credentials

          ret = connection.Login(username, password, server)

          If (ret <> 0) Then

              MsgBox ("Login failure. Check username, password and server.")

              'Logout of connection





          End If


          'Create and instantiate project variables

          Dim singleproj As PDMWProject

          Dim project As String

          Dim excludeList(3) As String

          Dim rootDrawingsPath As String

          'Dim test() As String

          Dim item

          Dim msg


          'alldocs is a collection of *all* vault documents

          Set alldocs = connection.Documents

          'allproj is a collection of *all* vault projects

          Set allproj = connection.Projects

          'excludeList is an array of strings of root level project names to exclude

          excludeList(0) = "Trash"

          excludeList(1) = "WIP"

          excludeList(2) = "Library Components"


          'Enter the path where the PDF directory tree should begin

          rootDrawingsPath = "C:\Drawings"


          'If the root path does not exist it will be created

          'NOTE: MkDir will only create the final directory if it does not exist.

          'It will not nest multiple directories in one operation.

          If Dir(rootDrawingsPath, vbDirectory) = "" Then

              MkDir (rootDrawingsPath)

          End If


          'Iterate through each project in the allproj collection.

          'If the project does not have a parent, then it is a root level

          'project in the vault.

          For Each singleproj In allproj

              If singleproj.Parent Is Nothing Then

              'test = Filter(excludeList, singleproj.Name)

                  If UBound(Filter(excludeList, singleproj.Name)) = -1 Then

                      ret = CreateFolderCheckForChild(singleproj, rootDrawingsPath)

                  End If

              End If



          'Logout of connection



      End Sub


      'This function is the meat of the program.  This function will call itself

      'as it iterates through the vault.  There is some optimization that should

      'be done here in order to limit the number of variable that are created

      'at each level and are held in memory until exit.  However, some of these

      'variables must not be global because I am relying on them remaining the

      'same after return from a nested call.

      Function CreateFolderCheckForChild(proj As PDMWProject, previousPath As String)

          'Create new path using "previousPath" and appending the project name

          Dim thisPath As String

          thisPath = previousPath + "\" + proj.Name

          'If the new directory does not exsit, then create it

          If Dir(thisPath, vbDirectory) = "" Then

              MkDir (thisPath)

          End If


      Any help would be massively appreciated.

        • Re: Exclude sub-folders....  Via Exclude list.
          Andreas Killer

          I don't have PDM, so I don't know what happens... but why not use an error handler and catch the error?


          In that function, add the line
            On Error GoTo Errorhandler
          as first line and this lines


            '!!AK-15.06.17 begin
            Exit Function
            If Err.Source = "" Then Err.Source = Application.Name
            Debug.Print "Source     : " & Err.Source
            Debug.Print "Error      : " & Err.Number
            Debug.Print "Description: " & Err.Description
            If MsgBox("Error " & Err.Number & ": " & vbNewLine & vbNewLine & _
                Err.Description & vbNewLine & vbNewLine & _
                "Enter debug mode?", vbOKCancel + vbDefaultButton2, Err.Source) = vbOK Then
              Stop 'Press F8 twice
            End If
          '!!AK-15.06.17 end


          directly before the line
            End Function


          Hope that helps.


            • Re: Exclude sub-folders....  Via Exclude list.
              Craig Bill

              Hello Andreas,

              Thank you for the information and support.

              Sorry for the delay but I've been on annual leave, just a quick update.....


              I have put the lines you said "On Error GoTo Errorhandler"  under the line "Function CreateFolderCheckForChild(...."


              Also the other lines directly before End function.

              On 1st run it came back with the same issue, solidwokrs throwing up " Unknown Error ... ", then if you try to stop or pause VBA it crashes solidwokrs.


              This lead me to belive its not that part of the process, maybe more along the lines of the renaming the PDF Files:


              "    'Iterate through all results

                  Dim filename

                  For Each result In results

                      'debug line to display each result

                      'msg = MsgBox(result.Name, vbCritical)


                      'If the document has an embedded PDF, then...

                      If result.Document.HasPDF <> 0 Then

                          'Create the new filename, deleting ".slddrw", inserting separator "_" and the revision

                          'filename = thisPath & "\" & Replace(result.Name, ".SLDDRW", "") & "_" & result.Revision & ".pdf"


                          'Check to see if the target file name already exists.  If so then skip file creation.

                          'If Dir(filename) = "" Then

                              'Save out the embedded pdf to the path

                              'NOTE: this will save "filename.SLDDRW.pdf"

                              result.Document.SaveAsPDF (thisPath)


                              'Rename the file saved above to the target filename

                              'Name thisPath & "\" & result.Name & ".pdf" As filename

                          End If

                     'End If"


              ^^ SO I TABBED OUT THESE LINES ^^

              Still seems to be working, without errors, so fingers crossed it was a renaming issue.....

            • Re: Exclude sub-folders....  Via Exclude list.
              Craig Bill

              Update / Solution.....


              Managed to find where the export was stopping.... it stops on "(archived)" documents, as with open checkout it kick back an error as it is archived.

              (Note our archived documents seem to appear anywhere rather than isolated in an archive folder..)



              Rather than trying to exclude specific folders through the macro, i setup a new PDM Login and removed any access for said  folders.

              This helped to some extent but there appeared to still be some archive documents scattered about the vault, so as the export function stopped i was able to locate archived documents to remove or restore as necessary.


              Probably not the most technical or workarounds but i learnt enough to get by, once setup & sorted new exports should be seamless.


              Hope this helps.