Code tìm đường dẫn (foder) lưu file excel đang mở.

anktdn · 14/9/09

Ví dụ em có 1 file excel (path.xls) đang mở , và file này đang được lưu tại ổ D:\ foder DATA\XEMPATH em muốn tại sheet1 ô C5 của file đang mở, khi thực hiện code sẽ kiểm tra đường dẫn của file này và tại ô C5 sẽ cho biết đường dẫn là : C5 = D:\DATA\XEMPATH\
(Code này có chức năng tìm kiếm đường dẫn đang lưu file và liệt kê đường dẫn ra tại 1 ô file đang mở cho mọi trường hợp.) Xin sự giúp đỡ của các Bác. Cảm ơn !
Em thử code
Sub test ()
Range("C5")= ActiveWorkbook.FullName
end sub
thì không cho kết quả, nhưng sử dụng
Application.ActiveWindow.Caption = ActiveWorkbook.FullName
thì được nhưng chỉ tại thanh tabbar của file đang mở.

thuyyeu99 · 14/9/09

anktdn đã viết:
Ví dụ em có 1 file excel (path.xls) đang mở , và file này đang được lưu tại ổ D:\ foder DATA\XEMPATH em muốn tại sheet1 ô C5 của file đang mở, khi thực hiện code sẽ kiểm tra đường dẫn của file này và tại ô C5 sẽ cho biết đường dẫn là : C5 = D:\DATA\XEMPATH\
(Code này có chức năng tìm kiếm đường dẫn đang lưu file và liệt kê đường dẫn ra tại 1 ô file đang mở cho mọi trường hợp.) Xin sự giúp đỡ của các Bác. Cảm ơn !
Em thử code
Sub test ()
Range("C5")= ActiveWorkbook.FullName
end sub
thì không cho kết quả, nhưng sử dụng
Application.ActiveWindow.Caption = ActiveWorkbook.FullName
thì được nhưng chỉ tại thanh tabbar của file đang mở.

bạn thử xem được không

PHP:

Sub test()
Sheet1.Range("C5") = ActiveWorkbook.Path & "/" & ActiveWorkbook.Name
End Sub

ndu96081631 · 14/9/09

anktdn đã viết:
Ví dụ em có 1 file excel (path.xls) đang mở , và file này đang được lưu tại ổ D:\ foder DATA\XEMPATH em muốn tại sheet1 ô C5 của file đang mở, khi thực hiện code sẽ kiểm tra đường dẫn của file này và tại ô C5 sẽ cho biết đường dẫn là : C5 = D:\DATA\XEMPATH\
(Code này có chức năng tìm kiếm đường dẫn đang lưu file và liệt kê đường dẫn ra tại 1 ô file đang mở cho mọi trường hợp.) Xin sự giúp đỡ của các Bác. Cảm ơn !
Em thử code
Sub test ()
Range("C5")= ActiveWorkbook.FullName
end sub
thì không cho kết quả, nhưng sử dụng
Application.ActiveWindow.Caption = ActiveWorkbook.FullName
thì được nhưng chỉ tại thanh tabbar của file đang mở.

Code ở trên chỉ cho ra kết quả khi file của bạn đã được lưu đàng hoàng
Tôi test thử với 1 file đã lưu, code chạy bình thường ---> Bạn thử lại xem

le tin · 11/8/10

Tìm đường dẫn trong tất cả ổ đĩa

Nhờ các bạn thêm giúp vào đoạn code này,sao cho tìm được hết trong các ô đĩa
Cảm ơn

Dim i As Long, MyDir As String
Range("A1").CurrentRegion.Offset(1).ClearContents
MyDir = ThisWorkbook.Path
With Application.FileSearch
.SearchSubFolders = True
.LookIn = MyDir
.Filename = "book*"
For i = 1 To .FoundFiles.Count
[A65536].End(xlUp).Offset(1) = .FoundFiles(i)
Next i
End With

ndu96081631 · 11/8/10

le tin đã viết:
Nhờ các bạn thêm giúp vào đoạn code này,sao cho tìm được hết trong các ô đĩa
Cảm ơn

Dim i As Long, MyDir As String
Range("A1").CurrentRegion.Offset(1).ClearContents
MyDir = ThisWorkbook.Path
With Application.FileSearch
.SearchSubFolders = True
.LookIn = MyDir
.Filename = "book*"
For i = 1 To .FoundFiles.Count
[A65536].End(xlUp).Offset(1) = .FoundFiles(i)
Next i
End With

MyDir chính là thư mục mà bạn cần tìm ---> Sửa nó thành cái gì đó tùy bạn
Ví dụ:
MyDir = "D:\"

le tin · 11/8/10

ndu96081631 đã viết:
MyDir chính là thư mục mà bạn cần tìm ---> Sửa nó thành cái gì đó tùy bạn
Ví dụ:
MyDir = "D:\"

Như vậy là phải liệt kê qua các ổ đĩa , chứ nó không tìm hết hả bạn

ndu96081631 · 12/8/10

le tin đã viết:
Như vậy là phải liệt kê qua các ổ đĩa , chứ nó không tìm hết hả bạn

Muốn duyệt qua các đĩa cứng phải dùng vòng lập bạn à
Đây là code:

PHP:

Sub Test()
  Dim Drv
  For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
    If Drv.DriveType = 2 Then MsgBox Drv.Path
  Next
End Sub

Vậy ta lồng vòng lập này vào code của bạn như sau:

PHP:

Sub Test()
  Dim i As Long, MyDir As String, Drv
  Range("A1").CurrentRegion.Offset(1).ClearContents
  For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
    If Drv.DriveType = 2 Then
      MyDir = Drv.Path
      With Application.FileSearch
        .NewSearch
        .SearchSubFolders = True
        .LookIn = MyDir
        .Filename = "book*.xls"
        .Execute
        For i = 1 To .FoundFiles.Count
          Cells(i, 1) = .FoundFiles(i)
        Next
      End With
    End If
  Next
End Sub

le tin · 14/8/10

Cảm ơn bạn NDU , giúp mình thêm đoạn code để lấy thư mục liền kề , ví dụ lấy xyz trong D:\abcd\fgh\xyz\file.xls

ndu96081631 · 14/8/10

le tin đã viết:
Cảm ơn bạn NDU , giúp mình thêm đoạn code để lấy thư mục liền kề , ví dụ lấy xyz trong D:\abcd\fgh\xyz\file.xls

Tức là bạn có file mang tên file.xls ===> Bạn muốn lấy tên thư mục chứa nó (chính là xyz) đúng không?
Có nhiều cách lắm!
Gữi bạn cách dùng hàm Dir

PHP:

Sub Test()
  Dim fPath As String
  fPath = "D:\abcd\fgh\xyz\file.xls"
  MsgBox Dir(Replace(fPath, "\" & Dir(fPath), ""), 16)
End Sub

Cách này xác định luôn đường dẩn ấy có tồn tại hay không
Ngoài ra còn cách khác (Dùng Split) ---> Không cần đường dẩn ấy tồn tại:

PHP:

Sub Test()
  Dim fPath As String, Tmp
  fPath = "D:\abcd\fgh\xyz\file.xls"
  Tmp = Split(fPath, "\")
  MsgBox Tmp(UBound(Tmp) - 1)
End Sub

thanhlanh · 14/8/10

ndu96081631 đã viết:

Muốn duyệt qua các đĩa cứng phải dùng vòng lập bạn à
Đây là code:

PHP:

Sub Test()
  Dim Drv
  For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
    If Drv.DriveType = 2 Then MsgBox Drv.Path
  Next
End Sub

Vậy ta lồng vòng lập này vào code của bạn như sau:

PHP:

Sub Test()
  Dim i As Long, MyDir As String, Drv
  Range("A1").CurrentRegion.Offset(1).ClearContents
  For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
    If Drv.DriveType = 2 Then
      MyDir = Drv.Path
      With Application.FileSearch
        .NewSearch
        .SearchSubFolders = True
        .LookIn = MyDir
        .Filename = "book*.xls"
        .Execute
        For i = 1 To .FoundFiles.Count
          Cells(i, 1) = .FoundFiles(i)
        Next
      End With
    End If
  Next
End Sub

Sao tại ổ C:\ có một file book1.xls nó không liệt kê tại cột A nhỉ? trong khi nó chạy thì có nhưng rồi lại xoá mất.

le tin · 14/8/10

thanhlanh đã viết:
Sao tại ổ C:\ có một file book1.xls nó không liệt kê tại cột A nhỉ? trong khi nó chạy thì có nhưng rồi lại xoá mất.

Bạn sửa chỗ này

Cells([A65536].End(xlUp).Row+1, 1) = .FoundFiles(i)

ndu96081631 · 15/8/10

thanhlanh đã viết:
Sao tại ổ C:\ có một file book1.xls nó không liệt kê tại cột A nhỉ? trong khi nó chạy thì có nhưng rồi lại xoá mất.

Sơ suất tí...
Sửa thành vầy sẽ nhanh hơn

PHP:

Sub Test()
  Dim i As Long, MyDir As String, Drv, fn, Arr(1 To 60000, 1 To 1)
  Range("A1").CurrentRegion.Offset(1).ClearContents
  For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
    If Drv.DriveType = 2 Then
      MyDir = Drv.Path
      With Application.FileSearch
        .NewSearch
        .SearchSubFolders = True
        .LookIn = MyDir
        .Filename = "book*.xls"
        .Execute
        For Each fn In .FoundFiles
          i = i + 1
          Arr(i, 1) = fn
        Next
      End With
    End If
  Next
  Range("A1").Resize(i).Value = Arr
End Sub

thanhlanh · 17/8/10

Tìm file bằng excel

ndu96081631 đã viết:

Sơ suất tí...
Sửa thành vầy sẽ nhanh hơn

PHP:

Sub Test()
Dim i As Long, MyDir As String, Drv, fn, Arr(1 To 60000, 1 To 1)
Range("A1").CurrentRegion.Offset(1).ClearContents
For Each Drv In CreateObject("Scripting.FileSystemObject").Drives
If Drv.DriveType = 2 Then
MyDir = Drv.Path
With Application.FileSearch
.NewSearch
.SearchSubFolders = True
.LookIn = MyDir
.Filename = "book*.xls"
.Execute
For Each fn In .FoundFiles
i = i + 1
Arr(i, 1) = fn
Next
End With
End If
Next
Range("A1").Resize(i).Value = Arr
End Sub

Dám "độ" lại của sư phụ nè, Anh xem thử, có gì góp ý và bổ sung nhé!

ndu96081631 · 17/8/10

thanhlanh đã viết:
Dám "độ" lại của sư phụ nè, Anh xem thử, có gì góp ý và bổ sung nhé!

Code của bạn đang làm việc theo kiểu: Tìm đến đâu thì điền kết quả đến nấy ---> Thử dùng mảng xem có cải thiện được tốc độ không nha!

thanhlanh · 17/8/10

ndu96081631 đã viết:
Code của bạn đang làm việc theo kiểu: Tìm đến đâu thì điền kết quả đến nấy ---> Thử dùng mảng xem có cải thiện được tốc độ không nha!

Dùng mảng như của anh thì tôi không cho tìm từng ổ đĩa được.
Bây giờ muốn nó liệt kê thêm 2 cột là dung lượng và thuột tính được không?

ndu96081631 · 17/8/10

thanhlanh đã viết:
Dùng mảng như của anh thì tôi không cho tìm từng ổ đĩa được.
Bây giờ muốn nó liệt kê thêm 2 cột là dung lượng và thuột tính được không?

2 cột hay 10 cột gì cũng làm được hết ---> Bạn cố gắng nghiên cứu trước đi (các bài toán về mảng đã được post nhiều rồi)

thanhlanh · 17/8/10

ndu96081631 đã viết:
2 cột hay 10 cột gì cũng làm được hết ---> Bạn cố gắng nghiên cứu trước đi (các bài toán về mảng đã được post nhiều rồi)

Nhưng mà code xác định dung lượng và thuột tính của file thì chưa biết, thôi để nghiên cứu thử.

ndu96081631 · 17/8/10

thanhlanh đã viết:
Nhưng mà code xác định dung lượng và thuột tính của file thì chưa biết, thôi để nghiên cứu thử.

- Lấy dung lượng ta dùng FileLen(Đường dẩn đến file)
- Lấy thuộc tính ta dùng CreateObject("Scripting.FileSystemObject").GetFile(Đường dẩn đến file).Attributes
Ví dụ:

PHP:

Sub Test()
  Dim fn As String
  fn = "C:\Documents and Settings\NHAV\Desktop\TIM_ FILE.xls"
  MsgBox FileLen(fn)
  MsgBox CreateObject("Scripting.FileSystemObject").GetFile(fn).Attributes
End Sub

thanhlanh · 18/8/10

ndu96081631 đã viết:
- Lấy dung lượng ta dùng FileLen(Đường dẩn đến file)
- Lấy thuộc tính ta dùng CreateObject("Scripting.FileSystemObject").GetFile(Đường dẩn đến file).Attributes
Ví dụ:

PHP:

Sub Test() Dim fn As String fn = "C:\Documents and Settings\NHAV\Desktop\TIM_ FILE.xls" MsgBox FileLen(fn) MsgBox CreateObject("Scripting.FileSystemObject").GetFile(fn).Attributes End Sub

Cảm ơn Anh, làm được rồi - Thật là hấp dẫn
Nhưng nếu tìm gặp một file với tên tiếng Việt có dấu thì Anh Bill không xác định dung lượng được -> lỗi

ndu96081631 · 18/8/10

thanhlanh đã viết:
Cảm ơn Anh, làm được rồi - Thật là hấp dẫn
Nhưng nếu tìm gặp một file với tên tiếng Việt có dấu thì Anh Bill không xác định dung lượng được -> lỗi

Lỗi nếu có là do hàm Filelen mà ra
Vậy thay nó luôn là được rồi
Chổ nào có
FileLen(fn)
thì thay bằng:
CreateObject("Scripting.FileSystemObject").GetFile(fn).Size

Code tìm đường dẫn (foder) lưu file excel đang mở.

Thành viên chính thức

Trùm Nhiều Chuyện

Huyền thoại GPE

Học mãi

Huyền thoại GPE

Học mãi

Huyền thoại GPE

Học mãi

Huyền thoại GPE

Thành viên tích cực

Học mãi

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Đếm ngược thời gian