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 (1 người xem)

[huonglien1901]

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!

 

[befaint]

Có thể như này.

Lấy file app.xml, rồi lấy danh sách tên sheets trong đó.. Code cho vụ này có một chủ đề dài dài làm hết rồi.

 

[snow25]

Có thể như này.

Lấy file app.xml, rồi lấy danh sách tên sheets trong đó.. Code cho vụ này có một chủ đề dài dài làm hết rồi.

View attachment 207434

View attachment 207433

khó vậy bác có cách nào khác không nhỉ bác

 

[huonglien1901]

Có thể như này.

Lấy file app.xml, rồi lấy danh sách tên sheets trong đó.. Code cho vụ này có một chủ đề dài dài làm hết rồi.

View attachment 207434

View attachment 207433

Anh có thể gửi đường link cho em tham khảo được không Anh?

Em cảm ơn Anh rất nhiều!

 

[befaint]

Anh có thể gửi đường link cho em tham khảo được không Anh?

Em cảm ơn Anh rất nhiều!

Tìm chủ đề của lão "ẹc ẹc" về "nén và giải nén file" ấy..

 

[huonglien1901]

Tìm chủ đề của lão "ẹc ẹc" về "nén và giải nén file" ấy..

Em có đọc rồi mà chưa biết cách làm ra sao? nhờ Anh hỗ trợ, Code của mấy Thầy kinh khủng quá!

 

[VetMini]

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.

 

[befaint]

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...

 

[AutoReply]

Ôi khủng khiếp !

Chuyện. anh phèn mà lị. Anh phèn viết toàn những đoạn code em chưa từng được thấy trong đời. Ngưỡng mộ quá

 

[♫ђöล♥ßล†♥†µ♫]

Anh chạy xong nó ra cái này.

View attachment 207459

Sao tuyệt vời vậy ạ. Nếu có mấy xị nữa là hoàn hảo rồi. Anh "Phèn" thêm vài đoạn Code nữa đi anh

 

[befaint]

Mình cũng nhớ anh phèn kinh khủng khiếp!

Nhớ làm chi đó anh?

Nhớ nhung là lại có chiện bi dờ.

 

[ndu96081631]

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)

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:

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

 

[excel_lv1.5]

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!

Thử dùng cách của bạn VetMini:

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

 

[huuthang_bd]

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)

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:

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

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/

 

[ndu96081631]

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/

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õ:

không được ráng chịu

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

 

[Trí Tín]

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?

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

 

[Quang_Hải]

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.

 

[VetMini]

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.

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.

 

[befaint]

Bà con ở đây chỉ thích vọc VBA và các Windows Ọbjects

Hình như mình đang 'được nói'.

Lúc đầu em còn dùng Command Prompt để đổi đuôi, PowerShell để giải nén ấy.