Lấy danh sách tên các Sheet từ file excel

Liên hệ QC

xuanhoa7604

Thành viên hoạt động
Tham gia
9/6/08
Bài viết
169
Được thích
82
Nghề nghiệp
Giáo viên
Bác nào biết cách lấy tên các sheet của một file excel (bằng VBA) mà không cần mở file đó không xin chỉ giáo? Xin cảm ơn trước!
 
Bác nào biết cách lấy tên các sheet của một file excel (bằng VBA) mà không cần mở file đó không xin chỉ giáo? Xin cảm ơn trước!
Bạn nghiên cứu code này xem:
PHP:
Function GetSheetsNames(WBName As String) As Collection
  'Vao menu Tools\References va check cac muc:
  '-Microsoft ActiveX Data Object X.X Library
  '-Microsoft ADO Ext. X.X for DLL and Security
  Dim objConn As ADODB.Connection, objCat As ADOX.Catalog, Col As New Collection, tbl As ADOX.Table
  Dim sConnString As String, sSheet As String
  sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
  "Data Source=" & WBName & ";" & "Extended Properties=Excel 8.0;"
  Set objConn = New ADODB.Connection
  objConn.Open sConnString
  Set objCat = New ADOX.Catalog
  Set objCat.ActiveConnection = objConn
  For Each tbl In objCat.Tables
    sSheet = tbl.Name
    sSheet = Application.Substitute(sSheet, "'", "")
    sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
   On Error Resume Next
   Col.Add sSheet, sSheet
   On Error GoTo 0
  Next tbl
  Set GetSheetsNames = Col
  objConn.Close
  Set objCat = Nothing
  Set objConn = Nothing
End Function
PHP:
Sub Test()
  Dim Col As Collection, Book As String, i As Long
  Book = "D:\Excel\Book1.xls"
  Set Col = GetSheetsNames(Book)
  For i = 1 To Col.Count
    MsgBox Col(i)
  Next i
End Sub
Chú ý: Bạn phải làm thêm 1 động tác nữa trước khi chạy code:
- Trong cửa sổ VBE, vào menu Tools\References và check vào 2 mục:
Microsoft ActiveX Data Object X.X Library
Microsoft ADO Ext. X.X for DLL and Security
- D:\Excel\Book1.xls ở đây chỉ là ví dụ, nếu bạn muốn Get SheetName cho file nào thì hãy sửa lại đường dẩn cho phù hợp
- Trong Sub Test() , ngay đoạn Book = "D:\Excel\Book1.xls" bạn có thể sửa lại thành FileDialog cho linh hoạt hơn
 

File đính kèm

  • GetSN_FromCloseWB.xls
    24.5 KB · Đọc: 306
Lần chỉnh sửa cuối:
Upvote 0
Thêm cho bạn 1 cách lấy tên sheet cho tất cả các file có trong folder bằng listbox
Bạn xem file nhé
Thân
 

File đính kèm

  • Lay Sheet Name.xls
    56 KB · Đọc: 429
Upvote 0
Thêm cho bạn 1 cách lấy tên sheet cho tất cả các file có trong folder bằng listbox
Bạn xem file nhé
Thân
File rất hoành tráng, tuy nhiên code dài quá ---> Nếu có thời gian rảnh rỗi bạn hãy làm cho nó gọn lại chút nhé
Ví dụ bạn có thể bỏ bớt Function BrowseForFolder, viết code thằng vào nút Browse luôn, tôi nghĩ sẽ gọn hơn rất nhiều đấy (dùng FileDialog chỉ có mấy dòng)
-------
Thêm nữa: code có thể bị lổi ngay khi vừa mở file ---> Hãy vào menu Tools\References xem lại coi có cái nào bị Missing không nha (nếu có thể lên Google tải lại file dll hoặc ocx về cài)
 
Lần chỉnh sửa cuối:
Upvote 0
Thực ra nói không mở file nhưng ta vẫn mở file mà không biết (mở kiểu ẩn), khi đó thủ tục gọn nhẹ hơn nhiều.
 
Upvote 0
Thực ra nói không mở file nhưng ta vẫn mở file mà không biết (mở kiểu ẩn), khi đó thủ tục gọn nhẹ hơn nhiều.
Dùng phương pháp mở file rồi lấy tên sheet đúng là khá gọn, tuy nhiên nếu lấy tên sheet của chính file hiện hành thì phải.. coi chừng (báo lổi) ---> Khi đó phải chỉnh lại code cho hợp lý (đại khái nếu chọn vào tên file hiện hành thì không mở file và vòng lập duyệt trực tiếp vào các sheet của file)
Tôi chỉnh lại code của bạn Domfootwear cho gọn lại
Code trong form
PHP:
Private Sub cmdSelDir_Click()
  Dim i As Long, MyDir As String
  On Error Resume Next
  lstWB.Clear
  With Application.FileDialog(4)
    .AllowMultiSelect = False: .Show:
    MyDir = .SelectedItems(1)
    txtUserDir = MyDir
    With Application.FileSearch
      .LookIn = MyDir: .Filename = "*.xls"
      If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
          lstWB.AddItem Replace(.FoundFiles(i), MyDir & "\", "")
        Next
      End If
    End With
  End With
End Sub
PHP:
Private Sub lstWB_Click()
  Dim i As Long
  Application.ScreenUpdating = False
  lstWS.Clear
  For i = 1 To GetSheetsNames(lstWB.Value).Count
    lstWS.AddItem GetSheetsNames(lstWB.Value)(i)
  Next
  Application.ScreenUpdating = True
End Sub
Chỉ nhiêu đó là đủ
Đương nhiên vẫn dùng hàm GetSheetsNames
 

File đính kèm

  • GetSN_FromCloseWB_02.xls
    46.5 KB · Đọc: 253
Upvote 0
Code lấy tên Sheet của file đóng

Bác nào biết cách lấy tên các sheet của một file excel (bằng VBA) mà không cần mở file đó không xin chỉ giáo? Xin cảm ơn trước!

Đây là code lấy tên Sheet của một file Excel không mở. Bạn chép code sau vào module của một file Excel rồi chạy nó. Lưu ý trước khi chạy, bạn cần đổi lại tên File cần lấy Sheet name cho phù hợp, tránh xảy ra lỗi
Thân


PHP:
Sub LayTenSh()
    Dim a As String, Ten As String
    Dim Wb As Workbook
    Dim Ws As Worksheet
    a = "D:\TongHop\GPE.xls"
    Set Wb = GetObject(a)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
End Sub
 
Upvote 0
Đây là code lấy tên Sheet của một file Excel không mở. Bạn chép code sau vào module của một file Excel rồi chạy nó. Lưu ý trước khi chạy, bạn cần đổi lại tên File cần lấy Sheet name cho phù hợp, tránh xảy ra lỗi
Thân


PHP:
Sub LayTenSh()
    Dim a As String, Ten As String
    Dim Wb As Workbook
    Dim Ws As Worksheet
    a = "D:\TongHop\GPE.xls"
    Set Wb = GetObject(a)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
End Sub
AnhPhuong xem lại nha... Code này tuy có gọn thật, nhưng vẫn còn rất nhiều nhược điểm cần giải quyết:
- Mổi lân ta lấy sheet name là 1 file được mở lên nhưng không được đóng lại ---> Có thể bấm Alt + F11 để kiểm tra, sẽ thấy tên file mở lần trước vẫn tồn tại
- Nếu ta thêm đoạn Wb.Close vào để đóng file thì lại thêm 1 chuyện rắc rối: Khi lấy tên sheet trên file hiện hành xong, nó tự đóng chính nó luôn
- Với Function dùng ADO thì lại hoàn toàn không có các hiện tượng trên
Vậy theo AnhPhuong ta giải quyết chuyện này thế nào đây?
 
Upvote 0
Hàm GetSheetsNames này tôi sưu tầm từ 1 trang web nước ngoài... Sau khi thí nghiệm nhiều lần mới phát hiện nó vẫn chưa chính xác ---> Các bạn thử GetSheetsNames trên 1 file nào đó có chứa Define name sẽ rõ
Trong hàm này, ta để ý đoạn code
PHP:
For Each tbl In objCat.Tables
   sSheet = tbl.Name
   .......
Next tbl
những tbl.Name nào trả về kết quả dạng ...$ hoặc ...$' (tên kết thúc bằng ký tự $ hoặc $') thì đấy chính là tên sheet
Từ đó suy ra ---> Để code chính xác ta phải sửa lại như sau:
PHP:
For Each tbl In objCat.Tables
  If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
    sSheet = Replace(Replace(tbl.Name, "$", ""), "'", "")
  End If
  Col.Add sSheet, sSheet
Next tbl
---------------
UDF này được định nghĩa As Collection ---> Vì thế khi ta Add vào ListBox lại phải tốn thêm 1 vòng lập nữa ---> Nếu như ta biến nó thành 1 mãng thì các phần việc sau đó sẽ gọn hơn rất nhiều... Đó là chưa nói tốc độ tính toán sẽ tăng thêm
Cải tiến lại, dùng hàm Split để biến nó thành mãng như sau:
PHP:
Function GetSheetsNames(WBName As String)
  Dim Temp As String
  ...................
  'Đoạn này giữ nguyên code cũ
  ...................
  For Each tbl In objCat.Tables
    If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
      Temp = Temp & Chr(10) & Replace(Replace(tbl.Name, "$", ""), "'", "")
    End If
  Next tbl
  GetSheetsNames = Split(Mid(Temp, 2, Len(Temp)), Chr(10))
  objConn.Close
End Function
Như vậy khi add list cho ListBox ta chỉ cần ngắn gọn thế này thôi:
PHP:
Private Sub lstWB_Click()
  lstWS.List() = GetSheetsNames(lstWB.Value)
End Sub
------------------
Ngoài ra tôi còn có nhận xét rằng: với những tbl.Name nào không chứa ký tự $ thì đấy chính là Define name ---> Từ đó ta có thể dùng hàm này chỉnh sửa lại đôi chút để lấy Define name trên 1 Workbook đang đóng
Tôi đã thí nghiệm rất nhiều lần và cho rằng nếu ta không dùng ADO mà Open file theo cách thông thường thì rất khó mà thực hiện được ----> Ví dụ file mà ta muốn lấy sheet name đang bị lổi, đương nhiên là nó không thể Open file này được rồi và sẽ báo lổi tùm lum
----------------
Hãy xem lại file đã chỉnh sửa lại... vẫn còn 1 vài chổ chưa hài lòng lắm, các bạn tiếp tục cải tiến nhé ---> ý tôi muốn nói đến việc cải tiến hàm GetSheetsNames để nó hoàn hảo hơn... hoặc cải tiến lại để có thể lấy Define name trên 1 WB đang đóng chẳng hạn
Về việc GetDefineNames, tôi đề xuất giải pháp như sau: (sửa lại vòng lập For)
PHP:
For Each tbl In objCat.Tables
  If InStr(tbl.Name, "$") = 0 Then
    Temp = Temp & Chr(10) & tbl.Name 'Replace(Replace(tbl.Name, "$", ""), "'", "")
  End If
Next tbl
 

File đính kèm

  • GetSN_FromCloseWB_03.xls
    57.5 KB · Đọc: 167
Lần chỉnh sửa cuối:
Upvote 0
Xin sửa lại code trên để có thể chạy trên Excel 2007
PHP:
Private Sub cmdSelDir_Click()
  On Error GoTo Thoat
  lstWB.Clear
  With Application.FileDialog(4)
    .AllowMultiSelect = False: .Show
    txtUserDir = .SelectedItems(1)
  End With
Thoat:
End Sub
PHP:
Private Sub txtUserDir_Change()
  Dim Temp As String, fN
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    For Each fN In .GetFolder(txtUserDir).Files
      If InStr(Right(fN.Name, 5), ".xls") Then
        Temp = Temp & Chr(10) & fN.Name
      End If
    Next
  End With
  lstWB.List() = Split(Mid(Temp, 2, Len(Temp)), Chr(10))
End Sub
PHP:
Private Sub lstWB_Click()
  Dim objConn As ADODB.Connection, objCat As ADOX.Catalog, tbl As ADOX.Table, Temp As String
  On Error Resume Next
  lstWS.Clear
  Set objConn = New ADODB.Connection
  objConn.Open "Provider=MSDASQL.1;Data Source=Excel Files; Initial Catalog=" & txtUserDir & "\" & lstWB
  Set objCat = New ADOX.Catalog
  Set objCat.ActiveConnection = objConn
  For Each tbl In objCat.Tables
    If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
      Temp = Temp & Chr(10) & Replace(Replace(tbl.Name, "$", ""), "'", "")
    End If
  Next tbl
  lstWS.List() = Split(Mid(Temp, 2, Len(Temp)), Chr(10))
  objConn.Close
End Sub
Bỏ UDF luôn
 

File đính kèm

  • GetSN_FromCloseWB_04.xls
    60 KB · Đọc: 230
Upvote 0
Cảm ơn anhtuan1066! Mình đã test và thấy bài này rất hay. Cho mình hỏi thêm từ sub này có thể phát triển thêm để khi ta Clich vào tên Sheet thì Sheet đó được Copy vào sheet hiện hành được không ? hiện tại trên GPE đã có sub lấy sheet (dùng cách mở File copy sheet xong đóng lại) chạy tương đối tốt nhưng có hạn chế là chỉ chọn được 1 file và đối với File dung lượng lớn, nhiều sheet thì chạy hơi chậm.
 
Upvote 0
Cảm ơn anhtuan1066! Mình đã test và thấy bài này rất hay. Cho mình hỏi thêm từ sub này có thể phát triển thêm để khi ta Clich vào tên Sheet thì Sheet đó được Copy vào sheet hiện hành được không ? hiện tại trên GPE đã có sub lấy sheet (dùng cách mở File copy sheet xong đóng lại) chạy tương đối tốt nhưng có hạn chế là chỉ chọn được 1 file và đối với File dung lượng lớn, nhiều sheet thì chạy hơi chậm.
Cách Import data từ 1 Workbook đang đóng đã từng nói nhiều rồi.. Theo em, anh nên dùng ADO (vì những ưu điểm vượt trội của nó)
Anh có thể tham khảo tại đây:
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado
Việc còn lại của anh là: Copy code, sửa lại đường dẩn đến file và chạy thử
 
Upvote 0
Cách Import data từ 1 Workbook đang đóng đã từng nói nhiều rồi.. Theo em, anh nên dùng ADO (vì những ưu điểm vượt trội của nó)
Anh có thể tham khảo tại đây:
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado
Việc còn lại của anh là: Copy code, sửa lại đường dẩn đến file và chạy thử
Hôm nay em dự định viết bài hỏi về vấn đề này, nhưng anh TrungChinh đã hỏi trước, em nghĩ dùng công cụ này phát triển ra thêm 1 listbox nữa để chọn tên sheet cần tổng hợp vào file trên nhiều file. Ý này rất hay.
 
Upvote 0
AnhPhuong xem lại nha... Code này tuy có gọn thật, nhưng vẫn còn rất nhiều nhược điểm cần giải quyết:
- Mổi lân ta lấy sheet name là 1 file được mở lên nhưng không được đóng lại ---> Có thể bấm Alt + F11 để kiểm tra, sẽ thấy tên file mở lần trước vẫn tồn tại
- Nếu ta thêm đoạn Wb.Close vào để đóng file thì lại thêm 1 chuyện rắc rối: Khi lấy tên sheet trên file hiện hành xong, nó tự đóng chính nó luôn
- Với Function dùng ADO thì lại hoàn toàn không có các hiện tượng trên
Vậy theo AnhPhuong ta giải quyết chuyện này thế nào đây?

Xin lỗi ndu96081631 và các bạn vì thời gian qua quá bận nên không thường xuyên lên mạng được vì thế hôm nay trả lời hơi trễ, mong các bạn thông cảm. Về vấn đề này, anhphuong xin được phép trả lời như sau :
1/ Thêm một hàm TimFile(Duongdan As String) để tìm ra tên một file từ đường dẫn cho trước. Hàm này tương tự như hàm tách tên để lấy tên ra từ Họ Tên cho trước
2/ Không thể dùng Wb.Close được vì nó đóng chính file đang chạy code.
Và dưới đây là code chạy :

PHP:
Sub LayTenSh()
    With Application
        .ScreenUpdating=False
        .DisplayAlerts = False
    End With
    On Error Resume Next
    Dim a As String, Ten As String
    Dim Wb As Workbook
    Dim Ws As Worksheet
    a = "D:\TongHop\GPE.xls"
    Ten = TimFile(a)
    Set Wb = GetObject(a)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
    Windows(Ten).Close False
    With Application
        .ScreenUpdating=True
        .DisplayAlerts = True
    End With
End Sub

Thân mến
 
Lần chỉnh sửa cuối:
Upvote 0
Xin lỗi ndu96081631 và các bạn vì thời gian qua quá bận nên không thường xuyên lên mạng được vì thế hôm nay trả lời hơi trễ, mong các bạn thông cảm. Về vấn đề này, anhphuong xin được phép trả lời như sau :
1/ Thêm một hàm TimFile(Duongdan As String) để tìm ra tên một file từ đường dẫn cho trước. Hàm này tương tự như hàm tách tên để lấy tên ra từ Họ Tên cho trước
2/ Không thể dùng Wb.Close được vì nó đóng chính file đang chạy code.
Và dưới đây là code chạy :

PHP:
Sub LayTenSh()
    With Application
        .ScreenUpdating=False
        .DisplayAlerts = False
    End With
    On Error Resume Next
    Dim a As String, Ten As String
    Dim Wb As Workbook
    Dim Ws As Worksheet
    a = "D:\TongHop\GPE.xls"
    Ten = TimFile(a)
    Set Wb = GetObject(a)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
    Windows(Ten).Close False
    With Application
        .ScreenUpdating=True
        .DisplayAlerts = True
    End With
End Sub
Thân mến
Cũng không được đâu! Nói chung là cách này có rất nhiều nhược điểm:
- AnhPhuong làm sao GetSheetName cho chính file hiện hành?
- Có thể GetSheetName cho 1 file đang bị lổi code không? (tức code bị lổi ngay khi open)
và còn rất nhiều trường hợp khác mà ta không thể dùng cách này được
Tóm lại: Open file là BẤT KHẢ THI
 
Upvote 0
Các bạn cho mình hỏi có cách nào cập nhật dữ liệu của file excel mà không cần mở không ? mong các bạn chỉ giáo !
 
Upvote 0
Cách Import data từ 1 Workbook đang đóng đã từng nói nhiều rồi.. Theo em, anh nên dùng ADO (vì những ưu điểm vượt trội của nó)
Anh có thể tham khảo tại đây:
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado
Việc còn lại của anh là: Copy code, sửa lại đường dẩn đến file và chạy thử

RRRRR... đã nhiều lần theo link của Ndu nhưng không làm được vì mù tiếng anh nên chẳng biết Copy đoạn nào (chỉ mở ra xem rồi đậy lại chẳng làm được gì) hôm nay điên tiết copy tất cả bài dán vào module thấy chữ nào lỗi thì xoá rồi sửa lại đường dẩn và chạy thử thì lấy được dữ liệu nhưng chẳng biết có xoá nhầm đoạn nào không mà chẳng thấy MsgBox nào hiện ra và bị lỗi Font mặc dù Sheet nguồn và Sheet đích đều dùng Unicode...hết võ. Bạn nào biết sửa code này (trong link) giúp mình với. Xin cảm ơn !
 
Lần chỉnh sửa cuối:
Upvote 0
RRRRR... đã nhiều lần theo link của Ndu nhưng không làm được vì mù tiếng anh nên chẳng biết Copy đoạn nào (chỉ mở ra xem rồi đậy lại chẳng làm được gì) hôm nay điên tiết copy tất cả bài dán vào module thấy chữ nào lỗi thì xoá rồi sửa lại đường dẩn và chạy thử thì lấy được dữ liệu nhưng chẳng biết có xoá nhầm đoạn nào không mà chẳng thấy MsgBox nào hiện ra và bị lỗi Font mặc dù Sheet nguồn và Sheet đích đều dùng Unicode...hết võ. Bạn nào biết sửa code này (trong link) giúp mình với. Xin cảm ơn !
Quả đúng là code ấy có vấn đề với Font tiếng Việt
Anh có thể thử bằng cách khác:
- Bật Record macro
- Vào menu Data\Import External Data\Import Data rồi duyệt đến source file nào đó
Sau khi ra kết quả, tắt record macro và Alt + F11 xem code
Xóa từng đoạn nhỏ, chạy code thí nghiệm ---> Mục đích là xem đoạn nào không cần thiết có thể bỏ bớt ---> Hơi cực đấy, nhưng em nghĩ cách này rất khả thi!
 
Upvote 0
Cũng không được đâu! Nói chung là cách này có rất nhiều nhược điểm:
- AnhPhuong làm sao GetSheetName cho chính file hiện hành?
- Có thể GetSheetName cho 1 file đang bị lổi code không? (tức code bị lổi ngay khi open)
và còn rất nhiều trường hợp khác mà ta không thể dùng cách này được
Tóm lại: Open file là BẤT KHẢ THI


Lâu lắm rồi mới quay lại GPE và gặp lại bài này. Xin chia sẻ một đoạn code sau, mọi người cùng tham khảo

PHP:
Sub LayTenSh()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    On Error Resume Next
    Dim Ten As String
    Dim Ex As Excel.Application
    Dim Wb As Excel.Workbook
    Dim Ws As Excel.Worksheet
    Ten = "E:\TongHop\GPE.xls"
    Set Ex = New Excel.Application
    Set Wb = Ex.Workbooks.Open(Ten)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
    Ex.Application.DisplayAlerts = False
    Wb.Close: Set Wb = Nothing: Set Ex = Nothing
    Ex.Application.DisplayAlerts = True
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub
Các bác xem và cho ý kiến nhé
Thân
 
Lần chỉnh sửa cuối:
Upvote 0
Lâu lắm rồi mới quay lại GPE và gặp lại bài này. Xin chia sẻ một đoạn code sau, mọi người cùng tham khảo

PHP:
Sub LayTenSh()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    On Error Resume Next
    Dim Ten As String
    Dim Ex As Excel.Application
    Dim Wb As Excel.Workbook
    Dim Ws As Excel.Worksheet
    Ten = "E:\TongHop\GPE.xls"
    Set Ex = New Excel.Application
    Set Wb = Ex.Workbooks.Open(Ten)
    For Each Ws In Wb.Sheets
        MsgBox "Ten Sheet la " & Ws.Name, , "Thong Bao"
    Next
    Ex.Application.DisplayAlerts = False
    Wb.Close: Set Wb = Nothing: Set Ex = Nothing
    Ex.Application.DisplayAlerts = True
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub
Các bác xem và cho ý kiến nhé
Thân
Có lẻ bác chưa hiểu ý em
Thôi thì bác chứ dùng code của bác, lấy tên sheet của file này xem:
http://www.giaiphapexcel.com/forum/showpost.php?p=167689&postcount=17
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom