لینک جدول از یک فایل به فایل دیگر

[amir91]

سلام دوستان عزیز
می خواستم ببینم امکان لینک جدول از یک فایل به فایل دیگر در دستورات vb به چه صورت است (می خواهم فایل، دیتابیس خود را در مسیر خود فایل پیدا کرده و جداول را که فایل آن دارای رمز است فراخوانی کند.)

[amir91]

سلام
کسی میدونه

[amir91]

سلام
من خودم یک کد پیدا کردم ولی نمی دونم اگر فایلی که قرار است جداول از آن لینک شود پسورد داشت چگونه این مشکل را حل کنم
"DoCmd.TransferDatabase acLink, "Microsoft Access", "D:\datebase.accdb", acTable, "tbl1", "Link_tbl1


D:\datebase.accdb: آدرس فایل مورد نظر (فایلی که دارای جدول مورد نظر می باشد.)
tbl1: جدول مورد نظر در فایل فوق
Link_tbl1: اسم جدول لینک شده در فایل جدید

[mehdihamedali]

سلام
من خودم یک کد پیدا کردم ولی نمی دونم اگر فایلی که قرار است جداول از آن لینک شود پسورد داشت چگونه این مشکل را حل کنم
"DoCmd.TransferDatabase acLink, "Microsoft Access", "D:\datebase.accdb", acTable, "tbl1", "Link_tbl1


D:\datebase.accdb: آدرس فایل مورد نظر (فایلی که دارای جدول مورد نظر می باشد.)
tbl1: جدول مورد نظر در فایل فوق
Link_tbl1: اسم جدول لینک شده در فایل جدید

سلام دوست عزیز
در جواب سوالت باید بگم که امکان این موضوع وجود داره
و باید بگم که برای انجام کار های بسیار بزرگ این کاری هست که حتما باید انجام بدید (یعنی این رو حتما یاد بگیر که خیلی خوب و واجبه)

ولی باید بگم که این کاری که پیدا کردی جواب کارت نیست باید از TableDef و از این جور چیز ها استفاده کنی اینا بهتره

موفق باشی

[AbbasSediqi]

این هم لینک برای همین موضوع

یا حق

http://barnamenevis.org/attachment.php?attachmentid=119269&d=1400605887

[amir91]

سلام
خوب بود ولی من چون با DAO آشنایی ندارم نتونستم ازش استفاده کنم در ضمن من نمی خواهم آدرس فایل بدهم می خواهم طوری تعریف کنم که فایل مورد نظر که کنار همان فایل است به آن لینک شود و هنگام بستن شدن لینک حذف شود این کار تا حدودی برای امنیت اطلاعات مناسب است.

[amir91]

سلام
من از ماژولی که شما نوشته بودید استفاده کردم
و در form_load فرم اصلی از کدهای زیر استفاده کردم

If CheckTableLinkConnection(TablesName, TempVars!Path, 8569031166#) = True Then
TableLinkCreate "table1", CurrentProject.Path & "\test.accdb", 123#
TableLinkCreate "table2", CurrentProject.Path & "\test.accdb", 123#
TableLinkCreate "table3", CurrentProject.Path & "\test.accdb", 123#
End If
و در Form_Close فرم اصلی از کدهای زیر استفاده کردم:

Private Sub Form_Close()
"DoCmd.DeleteObject acTable, "table1
"DoCmd.DeleteObject acTable, "table2
"DoCmd.DeleteObject acTable, "table1
End Sub

[AbbasSediqi]

البته این هم هم برای زمانی که چندین تیبل رو بخواهید لود کنید

فانکشن های fwrite برای اینه که فقط حروف فارسی تایپ بشه و FText برای اینه که در صورت کپی کردن متن فقط کلمات فارسی قبول میشه
فانکشن های NumberWrite برای اینه که فقط عدد تایپ بشه و NumberText برای اینه که در صورت کپی کردن متن فقط عدد قبول میشه



Option Compare Database


'Table_Link_Condition Argoments
Private Type TLC_Argoments
OnlyTest As Integer
AllConditionDeleteTable As Integer
DeleteDevastatedTableLink As Integer
NotExist As Integer
ExistAndNotConnect As Integer
ExistAndConnect As Integer
ExistButDeleted As Integer
End Type
'Table_Link_Condition TLC_Command
Public Enum TLC_Command
OnlyTest = 0
DeleteDevastatedTableLink = 1
AllConditionDeleteTable = 2
End Enum
'Table_Link_Condition Respond
Public Enum TLC_Result
NotExist = 0
ExistAndNotConnect = 1
ExistAndConnect = 2
ExistButDeleted = 3
End Enum


'Check_DB_Connection Argoments
Private Type CBCC_Argoments
Connected As Integer
NotConnected As Integer
End Type
'Check_DB_Connection Respond
Public Enum CDBCC_Result
Connected = 0
NotConnected = 1
End Enum


'Create_Table_Link Argoments
Private Type CTL_Argoments
Added As Integer
NotAdded As Integer
End Type
'Create_Table_Link Respond
Public Enum CTL_Result
Added = 0
NotAdded = 1
End Enum


'DB_Connection_Update Argoments
Private Type DBCU_Argoments
Yes_Or_No As Integer
Message As Integer
End Type
'DB_Connection_Update Respond
Public Enum DBCU_Respond
Yes_Or_No = 0
Message = 1
End Enum


'DB_Connection_Update Argoments
Private Type TextBox_Argoments
Respond As Integer
ControlSet As Integer
End Type
'DB_Connection_Update Respond
Public Enum TextBox_Condition
Respond = 0
ControlSet = 1
End Enum


Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long


Public Sub HideAccess()
Call ShowWindow(Access.hWndAccessApp, 0)
End Sub


Public Sub ShowAccess()
Call ShowWindow(Access.hWndAccessApp, 5)
End Sub


Public Function Search(Expr As String, Domain As String, txt_Search As String) As String
X = txt_Search '& " "
For i = 1 To Len(txt_Search)
C = InStr(1, X, " ")
If C > 0 Then
Y = Left(X, C - 1)
X = Right(X, Len(X) - C)
i = C
Q = Q & " and " & "((" & Domain & "." & Expr & ") like '*" & Y & "*')"
Else
Exit For
End If
Next i
Q = Q & " and " & "((" & Domain & "." & Expr & ") = '" & X & "')"
Search = Right(Q, Len(Q) - 5)
'Debug.Print x
End Function

Public Function Table_Link_Condition(TableName, Optional Command As TLC_Command = OnlyTest) As TLC_Result
On Error GoTo Error

DoCmd.OpenTable TableName, acViewNormal
DoCmd.Close acTable, TableName
If Command = AllConditionDeleteTable Then
DoCmd.DeleteObject acTable, TableName
Table_Link_Condition = ExistButDeleted
Else
Table_Link_Condition = ExistAndConnect
End If


Error:
If ERR.Number = 7873 Then
Table_Link_Condition = NotExist
ElseIf ERR.Number = 3024 Then
If Command = OnlyTest Then
Table_Link_Condition = ExistAndNotConnect
Else
DoCmd.DeleteObject acTable, TableName
Table_Link_Condition = ExistButDeleted
End If
End If
End Function


Private Function Check_DB_Connection(DBPath As String, DBPassword As String) As CDBCC_Result
On Error GoTo Error

PWD = ";pwd=" & DBPassword
Dim DB As DAO.Database
Set DB = DBEngine.OpenDatabase(DBPath, False, False, PWD)
Check_DB_Connection = Connected

Error:
If ERR.Number = 3031 Or ERR.Number = 3024 Then
Check_DB_Connection = NotConnected
End If
End Function


Private Function Create_Table_Link(TableName, DBPath As String, DBPassword As String) As CTL_Result
On Error GoTo Error


PWD = ";pwd=" & DBPassword
Dim DB As DAO.Database
Set DB = DBEngine.OpenDatabase(DBPath, False, False, PWD)
DBEngine.DefaultPassword = PWD
DoCmd.TransferDatabase acLink, "Microsoft Access", DBPath, acTable, TableName, TableName, True
Create_Table_Link = Added

Error:
If ERR.Number = 3011 Then
Create_Table_Link = NotAdded
End If
End Function


Public Function DB_Connection_Update(TablesName, DBPath As String, DBPassword As String, Optional Respond As DBCU_Respond) As String
Dim TablesCount As Integer
Dim TablesAdd As Integer
Dim TablesNotAdd As String
Dim TablesAdded As String
TablesCount = 0
TablesAdd = 0


If Check_DB_Connection(DBPath, DBPassword) = Connected Then

For Each Item In TablesName
TablesCount = TablesCount + 1
Table_Link_Condition Item, AllConditionDeleteTable

If Create_Table_Link(Item, DBPath, DBPassword) = Added Then
TablesAdd = TablesAdd + 1
TablesAdded = TablesAdded & " ; " & Item
Else
TablesNotAdd = TablesNotAdd & " ; " & Item
End If

Next

Else
Exit Function
End If

Dim AL, FL As Integer
Dim FNB, FNU As String
AL = Len(DBPath)
FL = InStrRev(DBPath, "\", , vbTextCompare)
FN = Left(Right(DBPath, AL - FL), (AL - FL) - 0)



If TablesAdd = TablesCount Then
If Respond = Yes_Or_No Then
DB_Connection_Update = Yes
ElseIf Respond = Message Or IsNull(Respond) Then
TablesAdded = Right(TablesAdded, Len(TablesAdded) - 3)
DB_Connection_Update = TablesAdd & " Tables : ( " & """" & TablesAdded & """" & " ) From : ( " & """" & FN & """" & " ) Added"
End If
Else
If Respond = Yes_Or_No Then
DB_Connection_Update = no
ElseIf Respond = Message Then
TablesNotAdd = Right(TablesNotAdd, Len(TablesNotAdd) - 3)
DB_Connection_Update = (TablesCount - TablesAdd) & " Tables : ( " & """" & TablesNotAdd & """" & " ) From : ( " & """" & FN & """" & " ) NotAdded"
End If
End If
End Function


Function fOSUserName() As String
On Error GoTo fOSUserName_Err


Dim lngLen As Long, lngX As Long
Dim strUserName As String

strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)

If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If


fOSUserName_Exit:
Exit Function

fOSUserName_Err:
MsgBox Error$
Resume fOSUserName_Exit
End Function


Public Function FText(TextBox As Control, Optional Condition As TextBox_Condition) As String
If IsNull(TextBox) Then
TextBox = ""
Else
Dim LT As Integer
Dim C, TXT As String
LT = Len(TextBox)
For L = 1 To LT
C = Left(Right(TextBox, (LT + 1) - L), 1)
If Asc(C) = 129 Or (Asc(C) >= 141 And Asc(C) <= 142) Or Asc(C) = 144 Or Asc(C) = 152 Or _
(Asc(C) >= 193 And Asc(C) <= 194) Or (Asc(C) >= 198 And Asc(C) <= 200) Or _
(Asc(C) >= 202 And Asc(C) <= 214) Or (Asc(C) >= 216 And Asc(C) <= 219) Or _
(Asc(C) >= 221 And Asc(C) <= 222) Or Asc(C) = 225 Or (Asc(C) >= 228 And Asc(C) <= 230) Or _
Asc(C) = 237 Then
If L = 1 Then
TXT = C
Else
TXT = TXT & C
End If
End If
Next
If Condition = Respond Or IsNull(Condition) Then
FText = TXT
Else
TextBox = TXT
End If
End If
End Function


Public Sub FWrite(KeyAscii As Integer)
If KeyAscii = 1569 Or KeyAscii = 1570 Or (KeyAscii >= 1574 And KeyAscii <= 1594) Or KeyAscii = 1601 Or KeyAscii = 11602 Or _
(KeyAscii >= 1604 And KeyAscii <= 1608) Or KeyAscii = 1662 Or KeyAscii = 1688 Or KeyAscii = 1670 Or _
KeyAscii = 1705 Or KeyAscii = 1711 Or KeyAscii = 1740 Or KeyAscii = 8 Then

KeyAscii = KeyAscii
Else
KeyAscii = 0
End If
End Sub


Public Function NumberText(TextBox As Control, Optional Condition As TextBox_Condition) As String
If IsNull(TextBox) Then
TextBox = ""
Else
Dim LT As Integer
Dim C, TXT As String
LT = Len(Text)
For L = 1 To LT
C = Left(Right(Text, (LT + 1) - L), 1)
If Asc(C) >= 48 And Asc(C) <= 57 Then
If L = 1 Then
TXT = C
Else
TXT = TXT & C
End If
End If
Next
If Condition = Respond Or IsNull(Condition) Then
NumberText = TXT
Else
TextBox = TXT
End If
End If
End Function
Public Sub NumberWrite(KeyAscii As Integer)
If KeyAscii >= 58 Or (KeyAscii <= 47 And KeyAscii <> 8 And KeyAscii <> 13) Then
KeyAscii = 0
End If
End Sub