VBA นำรายชื่อและวันที่ใน folder มาต่อกัน

[predee16]

ถ้าผมต้องการให้ข้อมูลใน folder ไปต่อกันที่ file เดิม (ไม่ลบหรือทับของเดิม) ชื่อซ้ำกันไม่เป็นไรครับ เพราะจะมีข้อมูลลดเพิ่มใน folder ตลอดเวลา ตามตัวอย่าง ต้องเพิ่ม code อย่างไรครับ จาก code เดิมที่มีอยู่
ขอบคุณมากครับ

Code: Select all

Sub ListAllFileNames()
Dim oFSO As Object
Dim ofolder As Object
Dim ofile As Object
Dim i As Integer
Dim LResult As Date
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ofolder = oFSO.GetFolder("D:\KPI 2022")
For Each ofile In ofolder.Files
Cells(i + 2, 1) = ofile.Name
i = i + 1
LResult = FileDateTime(ofile)
Cells(i + 1, 2) = LResult
Next ofile
End Sub

[snasui]

กรุณาแนบไฟล์ที่มี Code นี้มาด้วย จะได้สะดวกต่อการตอบของเพื่อนสมาชิก สำหรับไฟล์ที่จะแนบ Code มาได้ อย่างน้อยต้องมีนามสกุลเป็น .xlsm, .xlsb ครับ

[predee16]

แนบไฟล์ listNameFolder.xlsm ครับ

[snasui]

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

Code: Select all

Sub ListAllFileNames()
    Dim oFSO As Object
    Dim ofolder As Object
    Dim ofile As Object
    Dim i As Integer
    Dim LResult As Date
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set ofolder = oFSO.GetFolder("D:\KPI 2022")
    
    With ActiveSheet
        If .Range("a2").Value = "" Then
            i = 2
        Else
            i = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        End If
        For Each ofile In ofolder.Files
            If Application.CountIfs(.Range("a:a"), ofile.Name) = 0 Then
                Cells(i, 1) = ofile.Name
                Cells(i, 2) = FileDateTime(ofile)
                i = i + 1
            End If
        Next ofile
    End With
End Sub

[predee16]

เรียน อาจารย์ครับ ผมลองเอา Code ไปใส่แล้วลอง run ดู พบว่ามันไม่เพิ่มให้จำนวนให้ และ มีจำนวนเท่าเดิม ครับ

[snasui]

ถ้ามีอยู่แล้วมันจะไม่นำมาซ้ำครับ

หากต้องการให้มันซ้ำกรุณาแก้ไขมาเองก่อน ติดแล้วค่อยนำมาถามกันต่อครับ