làm thế nào có thể lấy tất cả tên sheet trong nhiều file mà không cần mở file

Liên hệ QC
huonglien1901

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,701
Được thích
2,433
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
Em chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

Em muốn lấy tất cả ca tên sheet có trong nhiều file vào file tổng hợp mà không cần mở file đó lên không?

Ví dụ như TRONG FILE EM:
fILE 1: 12.XLSX có chứa 3 sheetname(1.1,2.1,3.1)
22.xlsx có chứa 4 sheetname(4.1,4.2,4.3,4.4)
Em muốn có flle tổng hợp lấy tất cả các sheet name này!(trong sheetname có khi viết bằng tiếng việt) mà không cần mở file đó lên.

Em cảm ơn mọi người nhiều!
 

File đính kèm

  • tong hop.rar
    17.5 KB · Đọc: 10
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
1. ADODB OpenSchema
2. ADOX Catalog
Muốn làm cái này, trước hết phải hiểu lý thuyết thế nào là một CSDL (Database) và cái cơ cấu hạ tầng (Schema) của CSDL
Tôi đã giải thích một hay hai lần gì đó rồi.
 
Upvote 0
Bài này khá hay!
Xác định được tên sheets trong workbook rồi kết hợp với bài lấy dữ liệu từ file đóng là đủ bộ!!!

(Mới thử với Folder, File, Sheet có tên là unicode có dấu vẫn được, không biết còn lỗi lầm gì nữa..)

------
Xem lại, dùng file workbook.xml thì sẽ lấy được tên của sheet.VeryHidden và lấy được cả state nữa...

1541991200047.png
 

File đính kèm

  • GetSheetNames.xlsb
    26.6 KB · Đọc: 24
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Hồi lâu rồi mình có viết code dạng này, giờ đưa lên ai xài được thì xài (không được ráng chịu)
Mã: 
Function GetSheets(ByVal InThisFile As Boolean, ParamArray ExcelFiles())
  Dim Dbs  As Object, db As Object
  Dim tbItem, aTmp, item, arr(), tmp As String
  Dim n As Long, i As Long, lVersn As Long
  On Error Resume Next
  lVersn = Val(Application.Version)
  Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
  For i = LBound(ExcelFiles) To UBound(ExcelFiles)
    aTmp = ExcelFiles(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each item In aTmp
      If TypeName(item) = "String" Then
        If UCase$(item) Like "*.XLS" Or UCase$(item) Like "*.XLS?" Then
          If Not (UCase$(item) Like "*~$*.XLS*") Then
            If (CStr(item) <> ThisWorkbook.FullName) Or InThisFile Then
              Set db = Dbs.OpenDatabase(CStr(item), False, False, "Excel 8.0;")
              For Each tbItem In db.TableDefs
                tmp = tbItem.Name
                tmp = Replace(tmp, "''", "'")
                If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then
                  If Right(tmp, 2) = "$'" Then
                    tmp = Mid(tmp, 2, Len(tmp) - 3)
                  Else
                    If Right(tmp, 1) = "$" Then tmp = Left(tmp, Len(tmp) - 1)
                  End If
                  n = n + 1
                  ReDim Preserve arr(1 To n)
                  arr(n) = tmp
                End If
              Next
              db.Close
            End If
          End If
        End If
      End If
    Next
  Next
  If n Then GetSheets = arr
  Set Dbs = Nothing: Set db = Nothing
End Function
Ví dụ áp dụng:
Mã: 
Sub Main()
  Dim path As String
  Dim aFiles, aRes
  Sheet1.Range("A2:A10000").ClearContents
  path = ThisWorkbook.path
  aFiles = FilesFoldersList(path, True, "*.xls", False)
  If IsArray(aFiles) Then
    aRes = GetSheets(False, aFiles)
    If IsArray(aRes) Then
      Sheet1.Range("A2").Resize(UBound(aRes)).Value = WorksheetFunction.Transpose(aRes)
    End If
  End If
End Sub
Trong đó biến aFiles mà mảng các file, có được từ hàm FilesFoldersList, các bạn có thể dùng hàm khác cũng được
 
Upvote 0
huonglien1901 đã viết:
Em chào mọi người!

Em có vấn đề nhờ mọi người hỗ trợ.

Em muốn lấy tất cả ca tên sheet có trong nhiều file vào file tổng hợp mà không cần mở file đó lên không?

Ví dụ như TRONG FILE EM:
fILE 1: 12.XLSX có chứa 3 sheetname(1.1,2.1,3.1)
22.xlsx có chứa 4 sheetname(4.1,4.2,4.3,4.4)
Em muốn có flle tổng hợp lấy tất cả các sheet name này!(trong sheetname có khi viết bằng tiếng việt) mà không cần mở file đó lên.

Em cảm ơn mọi người nhiều!
Nhấp chuột vào đây để mở rộng...
Thử dùng cách của bạn VetMini:
PHP: 
Function gsname(filename)
Dim ado As Object, adox As Object, tableadox As Object, strpath As String, nsheet As String
strpath = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & filename & ";" & _
              "Extended Properties=Excel 12.0 Macro;"
Set ado = CreateObject("ADODB.Connection")
Set adox = CreateObject("ADOX.Catalog")
ado.Open strpath
Set adox.ActiveConnection = ado
For Each tableadox In adox.tables
    nsheet = Replace(tableadox.Name, "'", "")
    [a10000].End(xlUp).Offset(1).Value = filename
    [b10000].End(xlUp).Offset(1).Value = Left(nsheet, InStr(1, nsheet, "$", 1) - 1)
Next
ado.Close: Set adox = Nothing: Set ado = Nothing
End Function
Sub a()
Dim spath
[a2:b10000].Clear
With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "Excel file", "*.xls*", 1
    .AllowMultiSelect = True
    If .Show = -1 Then
        For Each spath In .SelectedItems
            gsname spath
        Next
    End If
End With
End Sub
 
Upvote 0
ndu96081631 đã viết:
Hồi lâu rồi mình có viết code dạng này, giờ đưa lên ai xài được thì xài (không được ráng chịu)
Mã: 
Function GetSheets(ByVal InThisFile As Boolean, ParamArray ExcelFiles())
  Dim Dbs  As Object, db As Object
  Dim tbItem, aTmp, item, arr(), tmp As String
  Dim n As Long, i As Long, lVersn As Long
  On Error Resume Next
  lVersn = Val(Application.Version)
  Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
  For i = LBound(ExcelFiles) To UBound(ExcelFiles)
    aTmp = ExcelFiles(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each item In aTmp
      If TypeName(item) = "String" Then
        If UCase$(item) Like "*.XLS" Or UCase$(item) Like "*.XLS?" Then
          If Not (UCase$(item) Like "*~$*.XLS*") Then
            If (CStr(item) <> ThisWorkbook.FullName) Or InThisFile Then
              Set db = Dbs.OpenDatabase(CStr(item), False, False, "Excel 8.0;")
              For Each tbItem In db.TableDefs
                tmp = tbItem.Name
                tmp = Replace(tmp, "''", "'")
                If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then
                  If Right(tmp, 2) = "$'" Then
                    tmp = Mid(tmp, 2, Len(tmp) - 3)
                  Else
                    If Right(tmp, 1) = "$" Then tmp = Left(tmp, Len(tmp) - 1)
                  End If
                  n = n + 1
                  ReDim Preserve arr(1 To n)
                  arr(n) = tmp
                End If
              Next
              db.Close
            End If
          End If
        End If
      End If
    Next
  Next
  If n Then GetSheets = arr
  Set Dbs = Nothing: Set db = Nothing
End Function
Ví dụ áp dụng:
Mã: 
Sub Main()
  Dim path As String
  Dim aFiles, aRes
  Sheet1.Range("A2:A10000").ClearContents
  path = ThisWorkbook.path
  aFiles = FilesFoldersList(path, True, "*.xls", False)
  If IsArray(aFiles) Then
    aRes = GetSheets(False, aFiles)
    If IsArray(aRes) Then
      Sheet1.Range("A2").Resize(UBound(aRes)).Value = WorksheetFunction.Transpose(aRes)
    End If
  End If
End Sub
Trong đó biến aFiles mà mảng các file, có được từ hàm FilesFoldersList, các bạn có thể dùng hàm khác cũng được
Nhấp chuột vào đây để mở rộng...
Có cách nào giải quyết được vấn đề ở topic sau không anh?
https://www.giaiphapexcel.com/diend...ằng-ado-dao-khi-tên-sheet-có-dấu-chấm.108491/
 

File đính kèm

  • Test GetSheets.rar
    19.9 KB · Đọc: 14
Upvote 0
huuthang_bd đã viết:
Có cách nào giải quyết được vấn đề ở topic sau không anh?
https://www.giaiphapexcel.com/diendan/threads/hỏi-lấy-dữ-liệu-bằng-ado-dao-khi-tên-sheet-có-dấu-chấm.108491/
Nhấp chuột vào đây để mở rộng...
Vì tôi biết code có giới hạn (lúc trước đã đọc topic kia rồi) nên tôi có nói rõ:
ndu96081631 đã viết:
không được ráng chịu
Nhấp chuột vào đây để mở rộng...
Nếu có ai đó có giải pháp hoàn chỉnh về việc dùng DAO cho vấn đề này thì tôi cũng muốn tham khảo và học hỏi
 
Upvote 0
Dear huonglien1901,

Em muốn lấy tất cả ca tên sheet có trong nhiều file vào file tổng hợp mà không cần mở file đó lên không?
Nhấp chuột vào đây để mở rộng...

Bạn thử tham khảo nội dung đường link sau đây ghi rõ cách lấy các sheet name trong 1 file Excel mà không cần mở file:
http://wizardvba.blogspot.com/2013/03/get-sheet-names-without-opening.html

Nếu tên sheet trong các file của bạn không có dấu đặc biệt ngoài dấu "." thì bạn replace dấu "#" thành dấu "." khi viết code.

Thân
 
Upvote 0
Cái công việc lấy tên sheet chắc là sẽ rất hiếm khi xài. Theo mình thà cứ sử dụng code mở file lấy tên sheet cho khỏi nhức đầu.
 
Upvote 0
quanghai1969 đã viết:
Cái công việc lấy tên sheet chắc là sẽ rất hiếm khi xài. Theo mình thà cứ sử dụng code mở file lấy tên sheet cho khỏi nhức đầu.
Nhấp chuột vào đây để mở rộng...
Có lẽ rất hiếm. Nhưng dịp để học hỏi thêm về Schema (cơ cấu hạ tầng) của Database (CSDL) còn hiếm hơn. Vì vậy ở bài #7, tôi có gợi ý bà con nên nhân dịp mà đào sâu vào.
Nhưng có lẽ toi đi quá xa. Bà con ở đây chỉ thích vọc VBA và các Windows Ọbjects.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
7
Đọc
154
HUONGHCKT
H
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
53
phantuancauvan
P
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
397
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
28
tby211
tby211
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
512
ngochienbmt
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom