Link các file Client vào 1 file tổng Admin (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

duyhanh

Thành viên mới
Tham gia
11/9/09
Bài viết
6
Được thích
0
Xin chào các anh, chị & các bạn trong diễn đàn

Mình đang làm IT cho 1 công ty chuyên về lĩnh vực truyền thông, công ty có yêu cầu 1 bài toán là làm thế nào để tổng hợp được báo cáo từ các nhóm AE vào 1 form tổng, sau khi đã đi gặp gỡ và trao đổi với KH về thì BLĐ muốn biết điều đó để có sự hỗ trợ cho các nhóm.
cụ thể như sau: ( gửi đính kèm file )
mình có 7 nhóm AE ( tổng cộng 15 người )
sau khi 15 người này đi gặp gỡ KH về sẽ nhập DL vào 1 form (client ) sau đó DL từ các Client đó sẽ tự động Update vào file form tổng: Admin để tiện cho BLĐ theo dõi.
nhưng mình làm không ổn lắm mong diễn đàn chỉ giáo thêm với ạ.


mong sớm nhận được hồi âm từ BQT diễn đàn.
Các Anh, chị & các bạn trong diễn đàn giúp duyhanh với nhé.



tks Agaiin
Duy HẠNH.




0936 165 196
Email: duyhanhgs@gmail.com
yahoo nick: pham_hanh2212
 

File đính kèm


để mình thử xem, tks hailua
------------------------------------------------------
Hailua ơi, hình như cái đó không đúng rồi. mình đã thử nhưng không đúng yêu cầu.
Hailua giúp mình nhé.

mình đã thử file đó nhưng mà kết quả ko như mong đợi Hailua ơi, khi file Admin để offline & nhập liệu ở file Client thì file Admin ko có kết quả, chỉ có kết quả khi cả 2 file cùng mở lên thì DL mới link sang thôi.
 
Chỉnh sửa lần cuối bởi điều hành viên:
mình đã thử file đó nhưng mà kết quả ko như mong đợi Hailua ơi, khi file Admin để offline & nhập liệu ở file Client thì file Admin ko có kết quả, chỉ có kết quả khi cả 2 file cùng mở lên thì DL mới link sang thôi.

Với yêu cầu của bạn như thế thì gộp nhiều file vào 1 file là đúng yêu cầu rồi, phải chạy code sau khi cập nhật các file.
 
thế hailua giúp mình đoạn code đó được không.
 
thế hailua giúp mình đoạn code đó được không.
Vậy bạn thử code sau:

[GPECODE=sql]Sub GopFile()
Dim cn As Object, adoRS As Object, cat As Object, tbl As Object, fld As Object, FileItem As Object
Dim strTableName As String, i As Integer, endR As Integer, strFile As String
Set cn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
Set cat = CreateObject("ADOX.Catalog")
Cells.ClearContents
For Each FileItem In CreateObject("Scripting.FileSystemObject").GetFolder(BrowseForFolder).Files
If FileItem.Path Like "*.xls" Then
strFile = FileItem.Path
strTableName = FileItem.Name
If strFile <> ThisWorkbook.FullName Then
With cn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & _
";Extended Properties=""Excel 8.0;HDR=Yes;HDR=Yes;IMEX=1"";"
.Open
End With
cat.ActiveConnection = cn
For Each tbl In cat.Tables
If (Right(tbl.Name, 1) = "$") Or (Right(tbl.Name, 2) = "$'") Then
strTableName = Replace(tbl.Name, "'", "")
With adoRS
.ActiveConnection = cn
.Open "SELECT '" & strFile & "' as [Duong Dan],'" & strTableName & "' as [Ten Sheet], * FROM [" & strTableName & "]"
endR = Range("A65000").End(xlUp).Row + 1
For Each fld In .Fields
i = i + 1
Cells(endR, i) = fld.Name
Next
Application.ScreenUpdating = False
Range("A" & endR + 1).CopyFromRecordset adoRS
Application.ScreenUpdating = True
.Close
cn.Close
End With
End If
Next
End If
End If
Next
Set cn = Nothing: Set adoRS = Nothing
Set adoRS = Nothing: Set cat = Nothing: Set tbl = Nothing
End Sub

[/GPECODE]

Nhớ chép hàm sau vào module
[GPECODE=vb]Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Vui long chon folder co chua file ma ban can gop.", 0, OpenAt)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
BrowseForFolder = False
End Function
[/GPECODE]

P/S: Code trên chưa test kỹ, bạn test giúp nhé.
 
Lần chỉnh sửa cuối:
tks hailua nhiều nhiều.
 
Web KT

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

Back
Top Bottom