لینک دو فایل اکسس

[mosaArabi]

با سلام
سئوال بنده در کلیت مشابه سایر دوستان میباشد . من دنبال لینک کردن از طریق منو تولز/ لینک منیجر یا از طریق ماکرو نیستم (البته سرچ هم کردم جیزی خازج از این موارد دستگیرم نشد).
از دوستان کسی دستور برقراری لینک از طریق ماژول به طوری که فایل اول در هر جای سیستم بود لینک برقرار شود را دارد؟(به طور خودکار)
با تشکر

[mazoolagh]

بصورت خودکار که خودش تمام دیسکها رو دنبال backend بگرده که کار درستی نیست
بهتر هست که از یک جای پیشفرض (مثلا فولدر خود frontend) شروع کنه و اگر نبود محلش رو از کاربر بپرسه. در اینصورت میتونم راهنمایی کنم.

[mosaArabi]

با سلام
دوست گرامی اگه لطف کنی و روش را توضیح بدی ممنون میشم (البته با یک نمونه بهتر میشه)
با تشکر

[mazoolagh]

این ضمیمه رو باز کنین - دو فایل نمونه FRONTEND و BACKEND هست
http://barnamenevis.org/forum/attachment.php?attachmentid=52412&d=1278406835
BACKEND دو جدول TABLE1 و TABLE2 داره که وقتی FRONTEND رو باز میکنین بصورت خودکار ATTACH میشه.
در FRONTEND یک جدول PARAMS هست که نام دیتابیس BACKEND و فولدر اون رو ذخیره میکنه (برای دفعات بعدی دیگه سئوال نمیکنه مگر اینکه فایل BACKEND رو در محلی که قبلا بوده پیدا نکنه)
شما میتونین اسم جداولی رو که میخواین ATTACH کنین در BE_TABLES ذخیره کنین
روتین ATTACH_BACKEND در دیتابیس BACKEND تمام این جداول رو به دیتابیس اصلی ATTACH میکنه و وقتی هم که فرم اصلی بسته میشه بصورت خودکار جداول DETACH میشن
ضمنا میتونین با PASSWORD اطلاعات BACKEND رو کد کنین که در اینصورت از CONNECT دیگه ای باید استفاده کنین که همونجا نمونه اش هست

Option Compare Database
Option Explicit
Private Sub Form_Close()
Call Detach_BackEnd
End Sub
Private Sub Form_Open(Cancel As Integer)
BE_TABLES = Array("TABLE1", "TABLE2")
BE_NAME = DLookup("BENAME", "PARAMS", "ID=1")
BE_FOLDER = DLookup("BEFOLDER", "PARAMS", "ID=1")
Do While Dir(BE_FOLDER & "\" & BE_NAME) = ""
BE_FOLDER = BrowseFolder("لطفا مسیر فایل اطلاعات را مشخص کنید" & vbCrLf & BE_NAME)
If BE_FOLDER = "" Then
V = MsgBox("مسیر فایل اطلاعات باید مشخص شود" & vbCrLf & "دوباره برنامه را اجرا کنید", vbOKOnly + vbMsgBoxRtlReading + vbCritical, "")
DoCmd.Quit acQuitSaveNone
End If
Loop
DoCmd.RunSQL ("UPDATE PARAMS SET BEFOLDER='" & BE_FOLDER & "' WHERE ID=1")
Call Attach_BackEnd
End Sub
Private Sub Attach_BackEnd()
Dim TDF As TableDef
Dim I As Integer
For I = 0 To UBound(BE_TABLES)
Dim T As TableDef
For Each T In CurrentDb.TableDefs
If T.Name = BE_TABLES(I) Then
CurrentDb.TableDefs.Delete (BE_TABLES(I))
CurrentDb.TableDefs.Refresh
Exit For
End If
Next
Set TDF = CurrentDb.CreateTableDef(BE_TABLES(I))
TDF.SourceTableName = BE_TABLES(I)
' TDF.Connect = "MS Access;PWD=**********;DATABASE=" & BE_FOLDER & "\" & BE_NAME
TDF.Connect = "MS Access;DATABASE=" & BE_FOLDER & "\" & BE_NAME
CurrentDb.TableDefs.Append TDF
Next
CurrentDb.TableDefs.Refresh
End Sub
Private Sub Detach_BackEnd()
Dim TDF As TableDef
Dim I As Integer
For I = 0 To UBound(BE_TABLES)
CurrentDb.TableDefs.Delete (BE_TABLES(I))
Next
CurrentDb.TableDefs.Refresh
End Sub
کد جستجوی محل دیتابیس رو کس دیگه ای نوشته :

Option Compare Database
Option Explicit
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function

[sajjad_kochekian]

سلام
من اجرا کردم ولی جواب نداد
شروع میکنه به جستجو
و به کد زیر که میرسته خطا میده
لطفا من رو راهنمایی کنید

Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
'*********** Code End *****************

[mazoolagh]

شما همون فایل ضمیمه رو باز کردین یا فقط همین کد رو توی برنامه خودتون کپی کردین؟

[MOAHHAMDREZA RAMIN]

نميخواهيم جايي خاصي را بگردد
يعني فايل در همان فلدري كه هست لينك ديگر هم در همان جا پيدا كند
يعني اگر دو فايل داريم در درايو دي :d پس مسير جاري براي لينك شناخته شود
و اگر به درايو ديگري رفت مسير جاري شناخته شده باشد
نه اينكه بدنبال آن بگردد!
فكر كنم اين راه هم كاربردي باشد
مثل استفاده از دو علامت "//"

[Sadiq Matin]

این ضمیمه رو باز کنین - دو فایل نمونه FRONTEND و BACKEND هست
http://barnamenevis.org/forum/attachment.php?attachmentid=52412&d=1278406835
BACKEND دو جدول TABLE1 و TABLE2 داره که وقتی FRONTEND رو باز میکنین بصورت خودکار ATTACH میشه.
در FRONTEND یک جدول PARAMS هست که نام دیتابیس BACKEND و فولدر اون رو ذخیره میکنه (برای دفعات بعدی دیگه سئوال نمیکنه مگر اینکه فایل BACKEND رو در محلی که قبلا بوده پیدا نکنه)
شما میتونین اسم جداولی رو که میخواین ATTACH کنین در BE_TABLES ذخیره کنین
روتین ATTACH_BACKEND در دیتابیس BACKEND تمام این جداول رو به دیتابیس اصلی ATTACH میکنه و وقتی هم که فرم اصلی بسته میشه بصورت خودکار جداول DETACH میشن
ضمنا میتونین با PASSWORD اطلاعات BACKEND رو کد کنین که در اینصورت از CONNECT دیگه ای باید استفاده کنین که همونجا نمونه اش هست

Option Compare Database
Option Explicit
Private Sub Form_Close()
Call Detach_BackEnd
End Sub
Private Sub Form_Open(Cancel As Integer)
BE_TABLES = Array("TABLE1", "TABLE2")
BE_NAME = DLookup("BENAME", "PARAMS", "ID=1")
BE_FOLDER = DLookup("BEFOLDER", "PARAMS", "ID=1")
Do While Dir(BE_FOLDER & "\" & BE_NAME) = ""
BE_FOLDER = BrowseFolder("لطفا مسیر فایل اطلاعات را مشخص کنید" & vbCrLf & BE_NAME)
If BE_FOLDER = "" Then
V = MsgBox("مسیر فایل اطلاعات باید مشخص شود" & vbCrLf & "دوباره برنامه را اجرا کنید", vbOKOnly + vbMsgBoxRtlReading + vbCritical, "")
DoCmd.Quit acQuitSaveNone
End If
Loop
DoCmd.RunSQL ("UPDATE PARAMS SET BEFOLDER='" & BE_FOLDER & "' WHERE ID=1")
Call Attach_BackEnd
End Sub
Private Sub Attach_BackEnd()
Dim TDF As TableDef
Dim I As Integer
For I = 0 To UBound(BE_TABLES)
Dim T As TableDef
For Each T In CurrentDb.TableDefs
If T.Name = BE_TABLES(I) Then
CurrentDb.TableDefs.Delete (BE_TABLES(I))
CurrentDb.TableDefs.Refresh
Exit For
End If
Next
Set TDF = CurrentDb.CreateTableDef(BE_TABLES(I))
TDF.SourceTableName = BE_TABLES(I)
' TDF.Connect = "MS Access;PWD=**********;DATABASE=" & BE_FOLDER & "\" & BE_NAME
TDF.Connect = "MS Access;DATABASE=" & BE_FOLDER & "\" & BE_NAME
CurrentDb.TableDefs.Append TDF
Next
CurrentDb.TableDefs.Refresh
End Sub
Private Sub Detach_BackEnd()
Dim TDF As TableDef
Dim I As Integer
For I = 0 To UBound(BE_TABLES)
CurrentDb.TableDefs.Delete (BE_TABLES(I))
Next
CurrentDb.TableDefs.Refresh
End Sub
کد جستجوی محل دیتابیس رو کس دیگه ای نوشته :

Option Compare Database
Option Explicit
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function


سلام خدمت تان بسیار سپاس گذارم ازین آموزش که به اشتراک گذاشتید و برای بنده بسیار کار ساز شد
اما شما اشاره کرده اید که میشه روی فایل بک اند پسورد گذاشت ولی من وقتی روی فایل بک اند پسورد گذاشتم فایل لینک نمیشه لطفا رهنمایی نمایید که چطور مشکل پسورد را حل کنم_ ممنون

[mazoolagh]

سلام خدمت تان بسیار سپاس گذارم ازین آموزش که به اشتراک گذاشتید و برای بنده بسیار کار ساز شد
اما شما اشاره کرده اید که میشه روی فایل بک اند پسورد گذاشت ولی من وقتی روی فایل بک اند پسورد گذاشتم فایل لینک نمیشه لطفا رهنمایی نمایید که چطور مشکل پسورد را حل کنم_ ممنون

سلام و نوروز شما پیروز
در کدهای پست شماره 8 اگر دقت کنین برای کانکشن با پسورد باید دستور زیر رو استفاده کنین (که اینجا کامنت شده):
TDF.Connect = "MS Access;PWD=**********;DATABASE=" & BE_FOLDER & "" & BE_NAME


در حالت ساده به جای * پسورد خودتون رو بگذارین،
ولی بهتره که این کانکشن رو به چندین تکه بشکنین (که اگر کسی دنبال کلمات کلیدی مثل database/pwd/... در سورس برنامه جستجو کرد کانکشن رو پیدا نکنه - هرچند که به هم ریخته است)
و برای پسورد هم از یک تابع استفاده کنین (و نه خود عبارت پسورد).