Get Creo File Names In Your Workfolder

 

 Call CreoVBAStart.CreoConnt01

connection to Creo

 

□ Code

Option Explicit
Sub FolderPartList01()
    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim stringseq As Istringseq
    Set stringseq = BaseSession.ListFiles("*.prt", 1, "")
    
    Dim i As Integer
    
    Dim fullPath As String
    Dim fileName As String
    Dim lastBackslash As Integer
    Dim fileVersionSeparator As Integer
    
    
    For i = 0 To stringseq.Count - 1
    
        Worksheets("program01").Cells(i + 4, "A") = i + 1
        fullPath = stringseq(i)
        lastBackslash = InStrRev(fullPath, "\")
        fileName = Mid(fullPath, lastBackslash + 1)
        fileVersionSeparator = InStrRev(fileName, ".")
        fileName = Left(fileName, fileVersionSeparator - 1)
        Worksheets("program01").Cells(i + 4, "B") = fileName
    
    Next i
    
    MsgBox "I brought all the part names.", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If
End Sub

Sub FolderAssembleList01()
    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim stringseq As Istringseq
    Set stringseq = BaseSession.ListFiles("*.asm", 1, "")
    
    Dim i As Integer
    
    Dim fullPath As String
    Dim fileName As String
    Dim lastBackslash As Integer
    Dim fileVersionSeparator As Integer
    
    
    For i = 0 To stringseq.Count - 1
    
        Worksheets("program01").Cells(i + 4, "A") = i + 1
        fullPath = stringseq(i)
        lastBackslash = InStrRev(fullPath, "\")
        fileName = Mid(fullPath, lastBackslash + 1)
        fileVersionSeparator = InStrRev(fileName, ".")
        fileName = Left(fileName, fileVersionSeparator - 1)
        Worksheets("program01").Cells(i + 4, "C") = fileName
    
    Next i
    
    MsgBox "I brought all the Assemble names.", vbInformation, "korealionkk@gmail.com"
    conn.Disconnect (2)
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If
End Sub

PROGRAM01.cls

0.00MB

 

Set stringseq = BaseSession.ListFiles("*.prt", 1, "")

0 = EpfcFILE_LIST_ALLList all files (including multiple versions of the same file).
1 = EpfcFILE_LIST_LATESTList only the latest version of each file.
2 = EpfcFILE_LIST_ALL_INSTSame as FILE_LIST_ALL, to show instances for PDM locations.
3 = EpfcFILE_LIST_LATEST_INSTSame as FILE_LIST_LATEST, to show instances for PDM locations.
4 = EpfcFileListOpt_nilUse this enumerated value to represent "null" passed to optional properties or method arguments.

 

by : korealionkk@gmail.com