Xin giúp đỡ code lấy tên tệp đuôi .txt

Liên hệ QC

Cát Lượng

Thành viên tiêu biểu
Tham gia
14/11/18
Bài viết
403
Được thích
66
Em chào các thầy và các anh/chị.
Em xin được giúp đỡ vấn đề sau ạ?
Tạo code để lấy được tên tệp .txt trong folder: Mỗi khi có tệp tên .txt được tạo chạy code sẽ lấy tệp tên đó và điền vào ô C5 trở đi trong cột C, đồng thời tạo liên kết (giống nhấn Ctrl + K) để mở tên tệp .txt đó lên luôn.
Mỗi khi chạy code để lấy và điền tên tệp .txt thì cũng điền luôn số thứ tự cột B.
Các tệp tin đuôi .txt và file excel có tên "Quanly_Code" cùng nằm trong một Folder
 

File đính kèm

  • Code VBA.rar
    7 KB · Đọc: 6
Mã:
Sub findfile()
Dim k As Long, ten As String, fso As Object, f As Object, fileObj As Object
    With ThisWorkbook.Worksheets("Sheet1")
        k = .Cells(Rows.count, "C").End(xlUp).Row
        If k > 4 Then .Range("B5:C" & k).ClearContents
    End With
    k = 4
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(ThisWorkbook.Path)
        For Each fileObj In f.Files
            If LCase(fileObj.Name) Like "*.txt" Then
                k = k + 1
                ten = fileObj.Name
                ten = Left(ten, InStr(1, ten, ".") - 1)
                With ThisWorkbook.Worksheets("Sheet1")
                    .Range("B" & k).Value = k - 4
                    .Hyperlinks.Add Anchor:=.Range("C" & k), Address:=ThisWorkbook.Path & "\" & fileObj.Name, _
                            TextToDisplay:=ten
                End With
            End If
        Next fileObj
    Set f = Nothing
    Set fso = Nothing
End Sub
 
Upvote 0
Mã:
Sub findfile()
Dim k As Long, ten As String, fso As Object, f As Object, fileObj As Object
    With ThisWorkbook.Worksheets("Sheet1")
        k = .Cells(Rows.count, "C").End(xlUp).Row
        If k > 4 Then .Range("B5:C" & k).ClearContents
    End With
    k = 4
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(ThisWorkbook.Path)
        For Each fileObj In f.Files
            If LCase(fileObj.Name) Like "*.txt" Then
                k = k + 1
                ten = fileObj.Name
                ten = Left(ten, InStr(1, ten, ".") - 1)
                With ThisWorkbook.Worksheets("Sheet1")
                    .Range("B" & k).Value = k - 4
                    .Hyperlinks.Add Anchor:=.Range("C" & k), Address:=ThisWorkbook.Path & "\" & fileObj.Name, _
                            TextToDisplay:=ten
                End With
            End If
        Next fileObj
    Set f = Nothing
    Set fso = Nothing
End Sub
Em cám ơn thầy. Chúc thầy nhiều sức khỏe và niềm vui!
 
Upvote 0
Web KT
Back
Top Bottom