VBA Get File Name

[Jirawat namrach]

รบกวนสอบถามหน่อยครับ ตามตัวอย่างมีการเปิด Folder ตาม cell G1:G2 ซึ่งเป็น Folder ย่อยใน ...Register\Drawing Control Copy SCAN\ และ Copy ชื่อไฟล์ มาวาง ถ้าต้องการค้นหาไฟล์ .pdf และ .jpg ใน ...Register\Drawing Control Copy SCAN\ ทั้งหมดที่เดียว โดยไม่ต้องกำหนดตาม G1:G25 ต้องแก้ Code ยังไงครับ

Code: Select all

For i = 1 To r
Path = "\\Lbox\eds\DCC\Register\Drawing Control Copy SCAN\" & Range("g" & i).Value
Set fso = New Scripting.FileSystemObject
Set fldr = fso.GetFolder(Path)
x = Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Row
For Each fil In fldr.Files
s.Sheets("Reg").Cells(x, 1) = fso.GetBaseName(fil.Name)
x = x + 1
Next fil
Next i

[snasui]

ลองศึกษาการ Loop ไปยัง Sub Folder ตาม Link นี้ดูแล้วปรับปรุง Code ดู ติดตรงไหนค่อยถามกันต่อครับ

https://snasui.com/viewtopic.php?t=19553
https://snasui.com/viewtopic.php?t=2710

[Jirawat namrach]

ขอบคุณครับอาจารย์

[Jirawat namrach]

สอบถามเพิ่มเติมครับ ตอนนี้ติดปัญหาว่า ตัว Code จะค้นหาเฉพาะไฟล์ใน Subfolder แต่บาง Folder ไม่มี Subfolder มีไฟล์ PDF เลย ต้องแก้ไขแบบไหน ให้สามารถค้นหาไฟล์ทั้งหมดใน Folder ครับ ไม่ว่าจะมี Sub หรือไม่มีก็ตาม

Code: Select all

Path = "\\Lbox\eds"
Set fso = New FileSystemObject
Set basefolder = fso.GetFolder(Path)
Set SubFolders = basefolder.SubFolders
l = 1
For Each folder In SubFolders
    Set files = folder.files
    For Each File In files
    If Right(File.Name, 4) = ".pdf" Then
    With Sheets("Reg")
        .Cells(l, 1).Value = fso.GetBaseName(File.Name)
    l = l + 1
    End With
    End If
    Next File
Next folder

[snasui]

กรุณาแนบตัวอย่างโครงสร้างของ Path พร้อมไฟล์ภายในที่จะใช้งานมาด้วย จะได้ช่วยทดสอบครับ

[Jirawat namrach]

แนบไฟล์ตัวอย่างครับ รบกวนด้วยครับอาจารย์

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Dim r As Long

Sub main()
    
    With Sheets(1).Range("A1")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    
    With Sheets(1)
        .Range("A3").Value = "Folder Path:"
        .Range("B3").Value = "Folder Name:"
        .Range("C3").Value = "Size:"
        .Range("D3").Value = "Subfolders:"
        .Range("E3").Value = "Files:"
        .Range("F3").Value = "File Names:"
        .Range("A3:G3").Font.Bold = True
    End With
    ' and include subfolders (true/false)
    ListFolders = "C:\Downloads\test", True
    Columns("A:F").AutoFit
End Sub


Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
    DoEvents
    Application.DisplayAlerts = False
    
    Dim fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
    
    Set fso = New Scripting.FileSystemObject
    Set SourceFolder = fso.GetFolder(SourceFolderName)
    
    On Error Resume Next
    
    r = Range("f65536").End(xlUp).Row + 1
    
    With Sheets(1)
        .Cells(r, 1).Value = SourceFolder.Path
        .Cells(r, 2).Value = SourceFolder.Name
        .Cells(r, 3).Value = SourceFolder.Size
        .Cells(r, 4).Value = SourceFolder.SubFolders.Count
        .Cells(r, 5).Value = SourceFolder.files.Count
    End With
    
    Findfiles (SourceFolder.Path)
    
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFolders SubFolder.Path, True
        Next SubFolder
        Set SubFolder = Nothing
    End If
      
    Set SourceFolder = Nothing
    Set fso = Nothing

End Sub

Sub Findfiles(d As String)
    Dim fname As String
    
    fname = Dir(d & "\*.pdf*")
    Do While fname <> ""
        Sheets(1).Cells(r, 6).Value = fname
        r = r + 1
        fname = Dir
    Loop
    
End Sub

กำหนดค่า "C:\Downloads\test" ใน Code ให้เป็น Path ที่ต้องการใช้งานจริง Code นี้นำมาจาก Link ตัวที่สองที่ให้ไว้ด้านบนครับ

กรณีต้องการคลิกด้วยปุ่ม ให้กำหนด Sub main ให้กับปุ่มนั้นครับ

[Jirawat namrach]

ขอบคุณครับอาจารย์