AnsweredAssumed Answered

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

Question asked by Craig Bill on Jun 9, 2017
Latest reply on Jul 5, 2017 by 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):

Capture.JPG

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

        connection.Logout

        End

    Else

   

    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

    Next

   

    'Logout of connection

    connection.Logout

   

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.

Attachments

Outcomes