Đố vui về ADO, DAO.

[doveandrose]

Có thể ít có người quan tâm về câu đố này quá nhỉ

em nghe nói có khai báo

"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"

xài được trên 2 phiên bản nhưng mà nó bị hạn chế quá , chắc không phải đáp án của anh nên không trả lời sớm .

 

[lenongree]

em nghe nói có khai báo

"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"

xài được trên 2 phiên bản nhưng mà nó bị hạn chế quá , chắc không phải đáp án của anh nên không trả lời sớm .

Cái khai báo này có sài được trong office 2016 hay win10 không anh, em sài foxpro kết nối với excel, nhưng bị vướng chỗ này không kết nối được!!!

 

[doveandrose]

Cái khai báo này có sài được trong office 2016 hay win10 không anh, em sài foxpro kết nối với excel, nhưng bị vướng chỗ này không kết nối được!!!

mình chỉ biết xài excel thôi nhé bạn , những thứ cao cấp như foxpro (nghe tên là thấy bờ-rồ) mình không biết bạn ơi .

 

[quanluu]

Mạnh cũng thử Góp vui một tí coi

I/ Có 50 File ở 50 Folder khác nhau ..và Ổ dĩa khác nhau VD: 25 Folder ở ổ E:\ và 25 Folder ở ổ D:\

1/ VD: E:\mm\1.xls
2/ VD: E:\mm\kk\2.xlsx
3/ VD: E:\hh\mm\kk\3.xls
.......................................
1/ VD: D:\mm\4.xls
2/ VD: D:\mm\kk\5.xlsb
3/ VD: D:\hh\mm\kk\6.xlsm
.......................................

II/ Có chung cấu trúc cần tổng Hợp như sau

1/ Tên Sheet cần tổng hợp là GPE

2/ Vùng dữ liệu cần tổng hợp là [A2:J100]

3/ Sử dụng ADO tổng hợp tất cả các file trên gán nối tiếp kết quả xuống 1 Sheet

4/ Không Sử dụng Array(file1,file2,file3 ......... To 50...........) để duyệt Files

5/ Không sử dụng cột phụ trên Sheet lấy đường dẫn của File xong chạy For Next ....

Rất mong các Bạn tham gia code chơi

xin cảm ơn

Không biết code này có đảm bảo yêu cầu của anh kieu manh ko?

Dim FSO As Object, FileItem As Object, cn As Object, rs As Object, SubFolder As Object


Sub kieumanh(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim query As String
Const ExcelExtension As String = "|xls|xlsb|xlsm|xlsx|"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


For Each FileItem In .GetFolder(SourceFolderName).Files
    If InStr(ExcelExtension, "|" & .GetExtensionName(FileItem.Path) & "|") Then
        If Left(FileItem.Name, 1) <> "~" And FileItem.Path <> ThisWorkbook.FullName Then
            With cn
                .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileItem.Path & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
                .Open
            End With
            query = " SELECT  * FROM [GPE$A2:J200]"
            rs.Open query, cn
            Range("A" & Range("A65000").End(3).Row + 1).CopyFromRecordset rs
            rs.Close: cn.Close
        End If
    End If
Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In .GetFolder(SourceFolderName).SubFolders
        kieumanh SubFolder.Path, True
        Next SubFolder
    End If
End With
    Set rs = Nothing: Set cn = Nothing
    Set FileItem = Nothing
    Set FSO = Nothing
End Sub


Sub run()
    Range("A2:J" & Range("A65000").End(3).Row).Clear
    Call kieumanh("E:\", True)
    Call kieumanh("D:\", True)
End Sub

 

[lenongree]

mình chỉ biết xài excel thôi nhé bạn , những thứ cao cấp như foxpro (nghe tên là thấy bờ-rồ) mình không biết bạn ơi .

Hic, fox nó đã bị bỏ rơi lâu rồi, các diễn đàn về fox từ từ cũng mất dần, em lạc hậu nên vẫn còn sài nó, nó vẫn còn hỗ trợ tốt trong một số trường hợp excel không làm được, nên em mới tạo liên kết giữa fox và excel, chắc có lẽ phải hài lòng với win 7 và excel 2013, thanks anh !!!

 

[Hai Lúa Miền Tây]

em nghe nói có khai báo

"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}"

xài được trên 2 phiên bản nhưng mà nó bị hạn chế quá , chắc không phải đáp án của anh nên không trả lời sớm .

BẠn cứ mạnh dạn gửi câu trả lời, chủ yếu là học hỏi kinh nghiệm lẫn nhau thôi mà bạn.

 

[doveandrose]

BẠn cứ mạnh dạn gửi câu trả lời, chủ yếu là học hỏi kinh nghiệm lẫn nhau thôi mà bạn.

ủa thì chuỗi đặt là

cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullName

có phải ý anh hỏi là : dùng chuỗi kết nối nào cho cả 2 phiên bản 2003 với 2007 ?

 

[Hai Lúa Miền Tây]

ủa thì chuỗi đặt là

cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullName

có phải ý anh hỏi là : dùng chuỗi kết nối nào cho cả 2 phiên bản 2003 với 2007 ?

Ý nói là viết hết cái sub, coi mức độ nó dài đến thế nào ý.

 

[doveandrose]

Ý nói là viết hết cái sub, coi mức độ nó dài đến thế nào ý.

à thì ra ý anh là thi viết code cho ngắn nhất , vậy thì em rớt từ ngoài vòng gửi xe rồi , không có hi vọng , nhưng thôi kệ có nhiêu nhậu nhiêu

Public Sub hello()
Dim cn As Object
Set cn = CreateObject("adodb.connection")
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullName
Sheet1.Range("A1").CopyFromRecordset cn.Execute("select * from [Sheet2$]")
End Sub

 

[Kiều Mạnh]

Không biết code này có đảm bảo yêu cầu của anh kieu manh ko?

Dim FSO As Object, FileItem As Object, cn As Object, rs As Object, SubFolder As Object


Sub kieumanh(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim query As String
Const ExcelExtension As String = "|xls|xlsb|xlsm|xlsx|"
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


For Each FileItem In .GetFolder(SourceFolderName).Files
    If InStr(ExcelExtension, "|" & .GetExtensionName(FileItem.Path) & "|") Then
        If Left(FileItem.Name, 1) <> "~" And FileItem.Path <> ThisWorkbook.FullName Then
            With cn
                .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileItem.Path & ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
                .Open
            End With
            query = " SELECT  * FROM [GPE$A2:J200]"
            rs.Open query, cn
            Range("A" & Range("A65000").End(3).Row + 1).CopyFromRecordset rs
            rs.Close: cn.Close
        End If
    End If
Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In .GetFolder(SourceFolderName).SubFolders
        kieumanh SubFolder.Path, True
        Next SubFolder
    End If
End With
    Set rs = Nothing: Set cn = Nothing
    Set FileItem = Nothing
    Set FSO = Nothing
End Sub


Sub run()
    Range("A2:J" & Range("A65000").End(3).Row).Clear
    Call [B]kieumanh("E:\", True)[/B]
    Call [B]kieumanh("D:\", True)[/B]
End Sub

Sáng tới giờ mình xuống Sài Gòn chơi ... mới về coi ....thấy không chạy được Vì lấy cả D hay E sao ....Mà trong Hai ổ đó có quá nhiều Folder nó duyệt hoài hay sao .... nếu để y trang vậy chạy là lỗi code

Nếu lấy 1 Foder thì Ok VD: D:\mm\*.xls"

 

[Kiều Mạnh]

à thì ra ý anh là thi viết code cho ngắn nhất , vậy thì em rớt từ ngoài vòng gửi xe rồi , không có hi vọng , nhưng thôi kệ có nhiêu nhậu nhiêu

Public Sub hello()
Dim cn As Object
Set cn = CreateObject("adodb.connection")
[COLOR=#ff0000][B]cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ="[/B][/COLOR] & ThisWorkbook.FullName
Sheet1.Range("A1").CopyFromRecordset cn.Execute("select * from [Sheet2$]")
End Sub

Cái dòng màu đỏ Mạnh thấy chạy hay lỗi trên một số máy lắm và lấy lên nó hay Lỗi Font....Nếu hỏi mình Tại sao ....Tịt


VD: Font Gốc =Thông ............. Nó Sang Th?ng

 

[quanluu]

Sáng tới giờ mình xuống Sài Gòn chơi ... mới về coi ....thấy không chạy được Vì lấy cả D hay E sao ....Mà trong Hai ổ đó có quá nhiều Folder nó duyệt hoài hay sao .... nếu để y trang vậy chạy là lỗi code

Nếu lấy 1 Foder thì Ok VD: D:\mm\*.xls"

Thật ra em mới chỉ test trên 1 folder (ổ E) với nhiều subfolders thôi. Tại vì anh bảo để trong 50 folder khác nhau mà ko rõ nhưng folder đó có chung đặc điểm gì không nên em phải đọc cả ổ ạ.

 

[Kiều Mạnh]

Thật ra em mới chỉ test trên 1 folder (ổ E) với nhiều subfolders thôi. Tại vì anh bảo để trong 50 folder khác nhau mà ko rõ nhưng folder đó có chung đặc điểm gì không nên em phải đọc cả ổ ạ.

Thì cấu trúc Folder nó lộn xộn như bài 240 đó

1/ VD: E:\mm\1.xls
2/ VD: E:\ma\kk\2.xlsx
3/ VD: E:\hh\mm\kk\3.xls
.......................................
1/ VD: D:\mm\4.xls
2/ VD: D:\mm\kk\5.xlsb
3/ VD: D:\hh\mm\kk\6.xlsm

Viết đơn giản thôi mà thay vì ta thường hay sử dụng Array(...) gán vao mãng thì ta dụng cách khác ngắn gọn và hay hơn thôi .....
Nếu 1 vài File thì Array Ok ... nhiều file thì thấy Gớm

 

[Hai Lúa Miền Tây]

Cái dòng màu đỏ Mạnh thấy chạy hay lỗi trên một số máy lắm và lấy lên nó hay Lỗi Font....Nếu hỏi mình Tại sao ....Tịt


VD: Font Gốc =Thông ............. Nó Sang Th?ng

Mình không đặt nặng vấn đề font, miễn sao lấy được dữ liệu thôi.

 

[Kiều Mạnh]

Mình không đặt nặng vấn đề font, miễn sao lấy được dữ liệu thôi.

Lấy thì OK rồi đó ... nhưng vẫn lỗi code trên 1 số máy ...Office 2007 lỗi chắc luôn

 

[quanluu]

Thì cấu trúc Folder nó lộn xộn như bài 240 đó

1/ VD: E:\mm\1.xls
2/ VD: E:\ma\kk\2.xlsx
3/ VD: E:\hh\mm\kk\3.xls
.......................................
1/ VD: D:\mm\4.xls
2/ VD: D:\mm\kk\5.xlsb
3/ VD: D:\hh\mm\kk\6.xlsm

Viết đơn giản thôi mà thay vì ta thường hay sử dụng Array(...) gán vao mãng thì ta dụng cách khác ngắn gọn và hay hơn thôi .....
Nếu 1 vài File thì Array Ok ... nhiều file thì thấy Gớm

Ý anh ở đây là đã biết trước đường dẫn của các file?

 

[Kiều Mạnh]

Ý anh ở đây là đã biết trước đường dẫn của các file?

đúng rồi đó ....vấn đề là duyệt file gán vào mãng làm sao cho nó gọn lại và không sử dụng cách mà trên GPE hay xài là Array(file1,file2,... To 50) vậy thôi hay lấy đường dẫn lên Sheet xong duyệt Files

 

[Hai Lúa Miền Tây]

Lấy thì OK rồi đó ... nhưng vẫn lỗi code trên 1 số máy ...Office 2007 lỗi chắc luôn

Vậy thì viết như thế nào cho nó chạy với các máy? Xét version là điều không thể tránh?

 

[Kiều Mạnh]

Vậy thì viết như thế nào cho nó chạy với các máy? Xét version là điều không thể tránh?

Hôm thấy code Anh Hải khai báo thấy chạy Tốt ...Nhưng chỉ Office 2007 là Lỗi
Còn xét theo Ver thì chạy Tuốt ....Chờ Bạn khai phá cách viết mới cho Mạnh Học với

 

[Lê Phát Huy]

Hôm thấy code Anh Hải khai báo thấy chạy Tốt ...Nhưng chỉ Office 2007 là Lỗi
Còn xét theo Ver thì chạy Tuốt ....Chờ Bạn khai phá cách viết mới cho Mạnh Học với

Nếu không xét vấn đền font thì tôi viết như sau:

Sub DoVui()
    With CreateObject("ADODB.Connection")
        .Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName
        Sheet2.[a2].CopyFromRecordset .Execute("Select * From [Sheet1$]")
    End With
    
End Sub