Noname > 11-09-10, 05:34 PM
Function getFile(Tit As String, formatName As String, formatType As String)
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
.Title = Tit
.Filters.Clear
.Filters.Add formatName, formatType
.AllowMultiSelect = False
result = .Show
If (result <> 0) Then
getFile = Trim(dlgOpen.SelectedItems.Item(1))
End If
End With
End Function
' lâìy vêÌ password cuÒa lâÌn connect trýõìc
Function getconnect(T As String) As String
Dim con As String
con = DLookup("[Connect]", "MSysObjects", "[name]='" & T & "'")
getconnect = con
End Function
'Liên kêìt table
Sub LinkTable(T As String, path As String, connectString As String)
Dim tblLink As TableDef
Dim DBlink As Database
Set DBlink = OpenDatabase(path, False, False, connectString)
On Error GoTo Err
DoCmd.DeleteObject acTable, T
Err:
DoCmd.TransferDatabase acLink, "Microsoft Access", path, acTable, T, T
'DBlink.Close
Set DBlink = Nothing
End Sub
Sub refreshLinkTable(path As String)
'Writen by:Noname
'Writen site: http://thuthuataccess.com/
'Please do not remove my info if using or share this modules
Dim r As Recordset
Dim s As String
s = "SELECT ForeignName FROM MSysObjects WHERE ForeignName Is Not Null"
Set r = CurrentDb().OpenRecordset(s)
If r.RecordCount > 0 Then
r.MoveLast
For i = 0 To r.RecordCount - 1
LinkTable r(0), path, getconnect(r(0))
r.MovePrevious
Next i
End If
r.Close
Set r = Nothing
End Sub
Private Sub cmdOpen_Click()
txtPath.Value = getFile("Select Data File", "data file", "*.mdb")
End Sub
Private Sub cmdreLink_Click()
refreshLinkTable Me.txtPath
MsgBox "link table thanh cong"
End Sub
DoquangLam > 12-09-10, 09:01 PM
Noname > 12-09-10, 09:17 PM
(12-09-10, 09:01 PM)DoquangLam Đã viết: Noname ơi, cám ơn bạn đã nhiệt tình hướng dẫn, nó phát sinh thêm lỗi này nữa, mong bạn quan tâm dùm nhé:Bài hướng dẫn bạn không đọc hết rồi!
- Nếu mình đổi mật khẩu ở file Data3 hoặc Data4 khi Link nó báo lỗi ngay dòng : Set DBlink = OpenDatabase(path, False, False, connectString)
- Còn áp dụng vào chương trình của mình thì khi Link nó báo lỗi ngay dòng : con = DLookup("[Connect]", "MSysObjects", "[name]='" & T & "'")
Mình cũng không biết nguyên nhân do đâu nữa, mong bạn trợ giúp.
Noname ơi, cám ơn bạn đã nhiệt tình hướng dẫn, nó phát sinh thêm lỗi này nữa, mong bạn quan tâm dùm nhé:
- Nếu mình đổi mật khẩu ở file Data3 hoặc Data4 khi Link nó báo lỗi ngay dòng : Set DBlink = OpenDatabase(path, False, False, connectString)
- Còn áp dụng vào chương trình của mình thì khi Link nó báo lỗi ngay dòng : con = DLookup("[Connect]", "MSysObjects", "[name]='" & T & "'")
Mình cũng không biết nguyên nhân do đâu nữa, mong bạn trợ giúp.
DoquangLam > 12-09-10, 09:36 PM
Noname > 12-09-10, 10:23 PM
haquocquan > 05-10-10, 12:08 AM
(12-09-10, 10:23 PM)Noname Đã viết: Nếu bạn đổi mật khẩu khác, bạn phải vào và link lại bằng tay, Từ lần sau nó mới nhớ! Chứ làm sao chương trình biết mật khẩu khác của bạn là gì mà link!
Noname > 05-10-10, 12:30 AM
Trích dẫn:'Liên kêìt table
Sub LinkTable(T As String, path As String, connectString As String)
Dim tblLink As TableDef
Dim DBlink As Database
Set DBlink = OpenDatabase(path, False, False, connectString)
On Error GoTo Err
DoCmd.DeleteObject acTable, T
Err:
DoCmd.TransferDatabase acLink, "Microsoft Access", path, acTable, T, T
'DBlink.Close
Set DBlink = Nothing
End Sub
haquocquan > 05-10-10, 02:01 AM
Noname > 05-10-10, 02:24 AM
(05-10-10, 02:01 AM)haquocquan Đã viết: connectString chính là pass do mình đặt, phải không Noname?
MS Access;PWD=yourpass;
MS Access;PWD=123456;
haquocquan > 10-11-10, 09:53 PM