กระทู้เก่าบอร์ด อ.Yeadram
2,612 4
URL.หัวข้อ /
URL
เชื่อต่อ Table ที่มี Password Protect File
คือมีปัญหาในการเขียนโค๊ด link table ที่มี password protect หนะครับ
เคยเอาโค๊ดที่หน้า web site ของคุณ yeadram ไปดู แต่มันค่อนข้างยาว
จริงอยากได้แค่ส่วนตรงที่มัน link table เข้ามาโดยให้มันใส่ password ให้อัตโนมัติเลยเท่านั้นหนะครับ
ใครพอชื้แนะได้ช่วยหน่อย
ข้างล่างนี่ผม copy code มา ซึ่งค่อนข้างยาว ผมจำ link ไม่ได้หนะครับ
Function ChangeDatabase()
Dim sq As String
Dim pw As String
Dim msg As String
Dim LinkFile As String
Dim aTb As Boolean
LinkFile = DLookup("Database", "MsysObjects", "[TYPE] = 6")
pw = Nz(DLookup("Connect", "MsysObjects", "[TYPE] = 6"), "")
If InStr(1, pw, "PWD") > 0 Then
msg = LinkFile & "-With Password!"
Else
msg = LinkFile
End If
sq = InputBox("Your current path is" & vbCrLf & msg & _
vbCrLf & "If you need to change path please retype then press OK button" & _
vbCrLf & "if The 'destination MDB' have a password ...." & _
vbCrLf & "input '-[your password]' after path", "Confirm path of your data", msg)
If IsNull(sq) Or IsEmpty(sq) Or sq = " " Then Exit Function
If tbExist("LinkTable") Then
Select Case MsgBox("Do you want re-link only table's name in 'LinkTable'?" & vbCrLf & _
"... if you said 'No' it will re-link All tables ...", vbQuestion + vbYesNoCancel, "How many tables")
Case vbYes
aTb = True
Case vbNo
aTb = False
Case Else
Exit Function
End Select
End If
If InStr(1, sq, "-") > 0 Then
Dim ar() As String
ar = Split(sq, "-", , vbTextCompare)
If ar(0) <> LinkFile Then
LinkFile = ar(0)
If ar(1) = "With Password!" Then
Linkdatabase LinkFile, pw, aTb
Else
Linkdatabase LinkFile, "MS Acess;PWD=" & ar(1) & ";", aTb
End If
End If
Else
If sq <> LinkFile Then
LinkFile = sq
Linkdatabase LinkFile, "", aTb
End If
End If
End Function
Function tbExist(ByVal tbN As String) As Boolean
Dim Rss As New ADODB.Recordset
Rss.Open "Select name from MsysObjects", CurrentProject.Connection, 1
Do While Not (Rss.EOF)
If Rss(0) = tbN Then
tbExist = True
Exit Function
End If
Rss.MoveNext
Loop
tbExist = False
End Function
Function Linkdatabase(ByVal LinkFile As String, Optional pw = "", Optional Alltb = True)
Dim cnn As New ADODB.Connection
Dim Rss As New ADODB.Recordset
Dim sq As String
Set cnn = Application.CurrentProject.Connection
If pw <> "" And InStr(1, LCase(pw), "access") = 0 Then pw = "MS Acess;PWD=" & pw & ";"
If Alltb = False Then
sq = "SELECT * FROM LinkTable"
Else
sq = "SELECT NAME FROM MsysObjects WHERE ([TYPE]=6)"
End If
Dim dbs As dao.Database
Dim tb As dao.TableDef
Dim j As Long
If Rss.State = 1 Then Rss.Close
Rss.Open sq, cnn, 1
j = Rss.RecordCount
Do While j <> 0
sq = Rss(0)
j = j - 1
If tbExist(Rss(0)) Then DoCmd.DeleteObject acTable, Rss(0)
If pw <> "" Then
Set dbs = DBEngine.Workspaces(0).OpenDatabase(LinkFile, False, False, pw)
For Each tb In dbs.TableDefs
If tb.Name = sq Then DoCmd.TransferDatabase acLink, "Microsoft Access", LinkFile, acTable, sq, sq, False, True
Next
dbs.Close
Set dbs = Nothing
Else
DoCmd.TransferDatabase acLink, "Microsoft Access", LinkFile, acTable, sq, sq, False
End If
Rss.MoveNext
Loop
Rss.Close
Set Rss = Nothing
Set cnn = Nothing
End Function
เคยเอาโค๊ดที่หน้า web site ของคุณ yeadram ไปดู แต่มันค่อนข้างยาว
จริงอยากได้แค่ส่วนตรงที่มัน link table เข้ามาโดยให้มันใส่ password ให้อัตโนมัติเลยเท่านั้นหนะครับ
ใครพอชื้แนะได้ช่วยหน่อย
ข้างล่างนี่ผม copy code มา ซึ่งค่อนข้างยาว ผมจำ link ไม่ได้หนะครับ
Function ChangeDatabase()
Dim sq As String
Dim pw As String
Dim msg As String
Dim LinkFile As String
Dim aTb As Boolean
LinkFile = DLookup("Database", "MsysObjects", "[TYPE] = 6")
pw = Nz(DLookup("Connect", "MsysObjects", "[TYPE] = 6"), "")
If InStr(1, pw, "PWD") > 0 Then
msg = LinkFile & "-With Password!"
Else
msg = LinkFile
End If
sq = InputBox("Your current path is" & vbCrLf & msg & _
vbCrLf & "If you need to change path please retype then press OK button" & _
vbCrLf & "if The 'destination MDB' have a password ...." & _
vbCrLf & "input '-[your password]' after path", "Confirm path of your data", msg)
If IsNull(sq) Or IsEmpty(sq) Or sq = " " Then Exit Function
If tbExist("LinkTable") Then
Select Case MsgBox("Do you want re-link only table's name in 'LinkTable'?" & vbCrLf & _
"... if you said 'No' it will re-link All tables ...", vbQuestion + vbYesNoCancel, "How many tables")
Case vbYes
aTb = True
Case vbNo
aTb = False
Case Else
Exit Function
End Select
End If
If InStr(1, sq, "-") > 0 Then
Dim ar() As String
ar = Split(sq, "-", , vbTextCompare)
If ar(0) <> LinkFile Then
LinkFile = ar(0)
If ar(1) = "With Password!" Then
Linkdatabase LinkFile, pw, aTb
Else
Linkdatabase LinkFile, "MS Acess;PWD=" & ar(1) & ";", aTb
End If
End If
Else
If sq <> LinkFile Then
LinkFile = sq
Linkdatabase LinkFile, "", aTb
End If
End If
End Function
Function tbExist(ByVal tbN As String) As Boolean
Dim Rss As New ADODB.Recordset
Rss.Open "Select name from MsysObjects", CurrentProject.Connection, 1
Do While Not (Rss.EOF)
If Rss(0) = tbN Then
tbExist = True
Exit Function
End If
Rss.MoveNext
Loop
tbExist = False
End Function
Function Linkdatabase(ByVal LinkFile As String, Optional pw = "", Optional Alltb = True)
Dim cnn As New ADODB.Connection
Dim Rss As New ADODB.Recordset
Dim sq As String
Set cnn = Application.CurrentProject.Connection
If pw <> "" And InStr(1, LCase(pw), "access") = 0 Then pw = "MS Acess;PWD=" & pw & ";"
If Alltb = False Then
sq = "SELECT * FROM LinkTable"
Else
sq = "SELECT NAME FROM MsysObjects WHERE ([TYPE]=6)"
End If
Dim dbs As dao.Database
Dim tb As dao.TableDef
Dim j As Long
If Rss.State = 1 Then Rss.Close
Rss.Open sq, cnn, 1
j = Rss.RecordCount
Do While j <> 0
sq = Rss(0)
j = j - 1
If tbExist(Rss(0)) Then DoCmd.DeleteObject acTable, Rss(0)
If pw <> "" Then
Set dbs = DBEngine.Workspaces(0).OpenDatabase(LinkFile, False, False, pw)
For Each tb In dbs.TableDefs
If tb.Name = sq Then DoCmd.TransferDatabase acLink, "Microsoft Access", LinkFile, acTable, sq, sq, False, True
Next
dbs.Close
Set dbs = Nothing
Else
DoCmd.TransferDatabase acLink, "Microsoft Access", LinkFile, acTable, sq, sq, False
End If
Rss.MoveNext
Loop
Rss.Close
Set Rss = Nothing
Set cnn = Nothing
End Function
4 Reply in this Topic. Dispaly 1 pages and you are on page number 1
2 @R05706
ครับเดี๋ยวจะลองและจะแจ้งผลนะครับ...
3 @R05707
ขึ้น Error นี้ครับ
Could not find installable ISAM. (Error 3170)
Could not find installable ISAM. (Error 3170)
4 @R05709
ได้แล้วครับ ดีใจจัง
ผมเพิ่มตรงนี้เข้าไป
Set dbs = DBEngine.Workspaces(0).OpenDatabase("c:\dest.mdb", False, False, ";pwd=12345")
ผมเพิ่มตรงนี้เข้าไป
Set dbs = DBEngine.Workspaces(0).OpenDatabase("c:\dest.mdb", False, False, ";pwd=12345")
Time: 0.2625s
เราจะทำการลิงค์ตารางมาจาก database ตัวอื่น
-เปิด database เป้าหมาย (ที่ติดพาสเวิร์ด) เอาไว้ก่อน
เปิดในแรม นะครับ คือไม่ต้องให้มันแสดงที่หน้าจอก็ได้ รันมันขึ้นมาในแรมก็พอ (workspace) แล้วทำการลิงค์ตารางเข้ามาที่ databaseA ของเรา
Set dbs = DBEngine.Workspaces(0).OpenDatabase("c:\dest.mdb", False, False, "12345")
DoCmd.TransferDatabase acLink, "Microsoft Access", "c:\dest.mdb", acTable, "table1", "table1", False, True
เมื่อทำงานเสร็จเราก็ปิด workspace นั้นเสีย (ล้างข้อมูลส่วนนี้ออกจากแรม)
dbs.Close
Set dbs = Nothing
สรุปคือ พาสเวอร์ด เราเอาไปใช้ในตอนเปิดมันเท่านั้นครับ แม้จะเปิดให้รันแค่ในแรม เราก็ต้องใช้มัน และเมื่อมันเปิดมาแล้ว มันก็ให้สิทธิ์เราทำอะไรได้ทุกอย่างแล้วครับ ต้องการลิงค์ตารางก็ทำได้อยู่แล้วครับเพราะกระบวนการตรวจสอบสิทธิ์ได้ผ่านสมบูรณ์ไปตั้งแต่ตอนสั่งเปิดแล้วครับ