Creo Parameter <=> PostgreSQL Table #6

폴더, 하위 폴더의 파일 이름 및 폴더 이름 가져 오는 코드 입니다. Creo 없이 동작 합니다

Reflash 버튼을 클릭하면, 폴더를 선택 할수 있고, 폴더와 하위 폴더에 있는 Creo Part, ASSEBLY, DRAWING 파일 이름을 표시 합니다. CREO 파일의 모든 버전을  표시 합니다.

File Name List.xlsm

0.09MB

 기본 코드

Option Explicit
Public WS As Worksheet

Sub GetFilesInFolder()
    Dim fldr As FileDialog
    Dim fldrPath As String
    Dim iRow As Long
    Dim hasCreoFiles As Boolean ' Creo 파일 존재 여부 확인 변수
 
    Set WS = ThisWorkbook.Worksheets("File_List")
    
    ' 폴더 선택 대화상자 생성
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "파일이 있는 폴더를 선택하세요"
        If .Show <> -1 Then Exit Sub ' 사용자가 취소하면 종료
        fldrPath = .SelectedItems(1)
    End With

    ' 엑셀 시트 초기화 (A열: 파일 번호, B열: 파일 이름, C열: 폴더 이름, D열: 파일 유형, E열: 수정 날짜)
    WS.Rows("8:" & WS.Rows.count).ClearContents
    iRow = 1
    hasCreoFiles = False ' 초기값 설정

    ' 재귀 함수 호출하여 파일 목록 가져오기
    Call ListFiles(fldrPath, iRow, hasCreoFiles)

    ' Creo 파일이 없는 경우 메시지 표시
    If Not hasCreoFiles Then
        MsgBox "Creo 파일이 없습니다!"
    Else
        MsgBox "파일 목록을 성공적으로 추출했습니다."
    End If
End Sub

Sub ListFiles(ByVal strFolder As String, ByRef iRow As Long, ByRef hasCreoFiles As Boolean)
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim fileType As String

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolder)

    ' 파일 목록에서 .PRT, .ASM, .DRW 포함하는 파일 필터링
    For Each objFile In objFolder.Files
        fileType = GetFileType(LCase(objFile.Name)) ' 파일 유형 확인
        If fileType <> "" Then
             WS.Cells(iRow + 7, "A").Value = iRow
             WS.Cells(iRow + 7, "B").Value = objFile.Name
             WS.Cells(iRow + 7, "C").Value = strFolder
             WS.Cells(iRow + 7, "D").Value = fileType ' 파일 유형 기록
             WS.Cells(iRow + 7, "E").Value = objFile.DateLastModified ' 수정 날짜 기록
             iRow = iRow + 1
             hasCreoFiles = True ' Creo 파일이 발견되면 True로 변경
        End If
    Next objFile

    ' 하위 폴더 재귀 호출
    For Each objFolder In objFolder.SubFolders
        Call ListFiles(objFolder.Path, iRow, hasCreoFiles)
    Next objFolder
End Sub

Function GetFileType(ByVal fileName As String) As String
    ' 파일 이름에 따라 파일 유형 반환
    If InStr(1, fileName, ".prt", vbTextCompare) > 0 Then
        GetFileType = "PRT"
    ElseIf InStr(1, fileName, ".asm", vbTextCompare) > 0 Then
        GetFileType = "ASM"
    ElseIf InStr(1, fileName, ".drw", vbTextCompare) > 0 Then
        GetFileType = "DRW"
    Else
        GetFileType = ""
    End If
End Function

Sub clear01()
    Dim CrentWS As Worksheet
    Set CrentWS = ThisWorkbook.Worksheets("File_List")
     
    CrentWS.Rows("8:" & CrentWS.Rows.count).ClearContents
End Sub

---