[ تمت الإجابة ]نسخ قاعدة بيانات خارجية من خلال قاعدة البيانات الحالي

تفضل اخي الكريم

نرى من الأفضل عدم تحديد موقع معين بالكود للقاعدة الثانية لأنك سوف تقيد نفسك وتقيد الأخرين بهذا العمل ولكن تركت الأمر مفتوح لإستعراض القاعدة الثانية او اي ملف وليس شرطا قواعد البيانات اكسيس بل اي ملف يخطر على بالك تريد نقله من اي مكان من جهاز الكمبيوتر الى اي مكان ايضا وذذلك من خلال اختياره فقط وسوف يتم نسخه الى الموقع المختار .

كما ترى في الصوره لديك ثلاث خطوات فقط

1. استعراض الملف المطلوب نسخه الى اي مكان

2. استعراض المكان او المجلد الذي سيتم حفظ الملف اليه

3. حفظ الملف في الموقع المحدد

لكي تقوم بإدارج هذا النموذج الى قاعدة بياناتك فيلزمك استيراد هذا النموذج وكذلك الوحدات النمطية الضرورية الخاصة بعملية الإستعراض والنسخ والحفظ

za_CopyAnyFileAndSaveToAnywhere.rar

بسم الله الرحمن الرحيم

كل الشكر أستاذتنا...جارى التحميل ثم التجربة وسوف نوافيكم بالرد بمشيئه الله

فأرجوا المتابعة

متميزه دائما استاذتنا الكريمة زهرة

جزاك الله خيرا

هذه الرساله تدل على وجود عدد 2 وحدات نمطيه لهما نفس الكود الخاص بفلتر الملفات ahtaddFilterItem موجوده لديك في البرنامج

اذهب الى الوحدات النمطية العامة الخاصة بفتح الملفات وقم بحذف واحده منها حيث ستجدها متشابهه بهذا الشكل

هذه الوحده النمطية في اخر ملف حملته من المنتدى بإسم modOpenSaveFile لا تقم بحذفها وانما احذف اللتي لديك سابقا في البرنامج قد يكون اسمها لديك سابقا Module1 او اي اسم

لا تحذف هذه الوحده النمطية modOpenSaveFile

Option Compare Database
Option Explicit

Type tagOPENFILENAME
	lStructSize As Long
	hwndOwner As Long
	hInstance As Long
	strFilter As String
	strCustomFilter As String
	nMaxCustFilter As Long
	nFilterIndex As Long
	strFile As String
	nMaxFile As Long
	strFileTitle As String
	nMaxFileTitle As Long
	strInitialDir As String
	strTitle As String
	Flags As Long
	nFileOffset As Integer
	nFileExtension As Integer
	strDefExt As String
	lCustData As Long
	lpfnHook As Long
	lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
	Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
	Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
	Dim strFilter As String
	Dim lngFlags As Long
	strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
					"*.MDA;*.MDB")
	strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
	strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
	strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
	MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
		Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
		DialogTitle:="Hello! Open Me!")
	Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
	Optional varTitleForDialog As Variant) As Variant
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
	lngFlags = ahtOFN_FILEMUSTEXIST Or _
				ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
	If IsMissing(varDirectory) Then
		varDirectory = ""
	End If
	If IsMissing(varTitleForDialog) Then
		varTitleForDialog = ""
	End If

	strFilter = ahtAddFilterItem(strFilter, _
				"Access (*.mdb)", "*.MDB;*.MDA")
	varFileName = ahtCommonFileOpenSave( _
					OpenFile:=True, _
					InitialDir:=varDirectory, _
					Filter:=strFilter, _
					Flags:=lngFlags, _
					DialogTitle:=varTitleForDialog)
	If Not IsNull(varFileName) Then
		varFileName = TrimNull(varFileName)
	End If
	GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
			Optional ByRef Flags As Variant, _
			Optional ByVal InitialDir As Variant, _
			Optional ByVal Filter As Variant, _
			Optional ByVal FilterIndex As Variant, _
			Optional ByVal DefaultExt As Variant, _
			Optional ByVal FileName As Variant, _
			Optional ByVal DialogTitle As Variant, _
			Optional ByVal hwnd As Variant, _
			Optional ByVal OpenFile As Variant) As Variant

Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
	If IsMissing(InitialDir) Then InitialDir = CurDir
	If IsMissing(Filter) Then Filter = ""
	If IsMissing(FilterIndex) Then FilterIndex = 1
	If IsMissing(Flags) Then Flags = 0&
	If IsMissing(DefaultExt) Then DefaultExt = ""
	If IsMissing(FileName) Then FileName = ""
	If IsMissing(DialogTitle) Then DialogTitle = ""
	If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
	If IsMissing(OpenFile) Then OpenFile = True
	strFileName = Left(FileName & String(256, 0), 256)
	strFileTitle = String(256, 0)
	With OFN
		.lStructSize = Len(OFN)
		.hwndOwner = hwnd
		.strFilter = Filter
		.nFilterIndex = FilterIndex
		.strFile = strFileName
		.nMaxFile = Len(strFileName)
		.strFileTitle = strFileTitle
		.nMaxFileTitle = Len(strFileTitle)
		.strTitle = DialogTitle
		.Flags = Flags
		.strDefExt = DefaultExt
		.strInitialDir = InitialDir
		.hInstance = 0
		.lpfnHook = 0
		.strCustomFilter = String(255, 0)
		.nMaxCustFilter = 255
	End With
	If OpenFile Then
		fResult = aht_apiGetOpenFileName(OFN)
	Else
		fResult = aht_apiGetSaveFileName(OFN)
	End If

	If fResult Then
		If Not IsMissing(Flags) Then Flags = OFN.Flags
		ahtCommonFileOpenSave = TrimNull(OFN.strFile)
	Else
		ahtCommonFileOpenSave = vbNullString
	End If
End Function

Function ahtAddFilterItem(strFilter As String, _
	strDescription As String, Optional varItem As Variant) As String
	If IsMissing(varItem) Then varItem = "*.*"
	ahtAddFilterItem = strFilter & _
				strDescription & vbNullChar & _
				varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
	intPos = InStr(strItem, vbNullChar)
	If intPos > 0 Then
		TrimNull = Left(strItem, intPos - 1)
	Else
		TrimNull = strItem
	End If
End Function

بسم الله الرحمن الرحيم

تمت الإجابة على الموضوع

إدارة الفريق العربي للبرمجة

بسم الله الرحمن الرحيم

أستاذتنا زهره ... سلام الله عليكي

كما ذكرت أن البرنامج يعمل بكفاءه ...ولكنى أغفلت تجربته من داخل برنامجى بعد أستيراده وقمت بتجربته من خلال النموذج الخاص بكم مباشرةً بعد استيراده

وقد شُغلت عن البرنامج بتكليف من الوزارة بتدريب بعض الزملاء الجدد على الإكتشاف المبكر لسرطان الأطفال

والأن قمت بعمل زر أمر لفتح نموذج النسخ الخاص بكم فى النموذج الرئيسى بقاعدتى

* بعد فتح النموذج وأختيار القاعده الهدف للنسخ وهى قاعده الجداول ثم أختيار مكان نسخها ثم الضغط على زر النسخ تظهر الرسالهPermission denied

وقد لاحظت أن الرساله تظهر فقط إذا كانت قاعده الجداول مفتوحه حيث أنى أستطيع نسخ أى قاعده من داخل البرنامج إلا قاعدةالجداول لا يتم نسخها إن كانت القاعده تعمل

شكراً لكم وأرجوا الإفاده

فى حفظ الله

bakkar2000 كتب:

* بعد فتح النموذج وأختيار القاعده الهدف للنسخ وهى قاعده الجداول ثم أختيار مكان نسخها ثم الضغط على زر النسخ تظهر الرسالهPermission denied

وقد لاحظت أن الرساله تظهر فقط إذا كانت قاعده الجداول مفتوحه حيث أنى أستطيع نسخ أى قاعده من داخل البرنامج إلا قاعدةالجداول لا يتم نسخها إن كانت القاعده تعمل

اخي الفاضل

من شروط نسخ اي قاعدة خارجية او حتى اي ملف خارجي يجب ان يكون مغلق اما اذا كان مفتوح فحتما ستظهر لك رسالة عدم السماح بذلك

لذا يجب اغلاق اي ملف سواء قاعدة البيانات او غيرها قبل عملية النسخ وهذه الخاصية من خصائص اي ملف في الجهاز ولا علاقة لبرنامج الأكسيس او غيره بذلك .

بسم الله الرحمن الرحيم

سلام الله عليكى أستاذه زهـــــــــــــــره

إذاً ما الحل أستاذتنا ....أشعرأن لديكى حل لذلك مثل ....

* أن نقوم بكتابة كود يقوم بأختبار القاعده الهدف إن كانت مفتوحه أم لا فإن لم تكن وهذا غير وارد على أساس أن النسخ يتم من داخل البرنامج و هو مفتوح

* ثم كود أخر يقوم بغلق هذه القاعدة

* ثم تتم العمليات الإعتياديه الخاصة بنسخ هذه القاعده

*ثم الرساله المعهوده بنجاح النسخ

* وعند إغلاف الرساله يتم فتح القاعده التى سبق وأن أغلقناها ثم الربط ثانيتاً بقاعده النماذج

لكن هل تتأثر قاعدة النماذج بعد أغلاق قاعدة الجداول وهى ماذالت مفتوحه

وهل بعد إعادة الربط تعمل قاعدة النماذج بنفس الكفاءه

الله ورسوله أعلم

لكنها مجرد أفكار .... وأشعر يقيناً أن لديكي الحل الأمثل

تذكرت الأن .........

أليس هذا مثالكم يقوم بنسخ قاعده مفتوحه ولكن الفرق أنى سوف أقوم بنسخ قاعده الجداول أى قاعده مفتوحه ولكن خارجيه

CopyToAnyWhere.rar

قد يكون هناك فروق أخرى لا أراها ...لكن أليس هذا صحيح

خالص شكري وأمتناني

بسم الله الرحمن الرحيم

أخوانى يبدوا أن الأمر فعلاً صعب جداً وقد يكون مستحيل لدرجة أنه منعكم من الرد علينا بأى شىء حتى و لو جملة مش ممكن يتم تنفيذ هذا أو أننا نقوم ببعض المحاولات

حتى يتثنا لنا إما الصبر وأنتظار الرد أو نصرف النظر عن الأمر ونستغل الوقت فى شىء أخر قد يفيد

فبالله عليكم لا تدعونا كالمعلق فى الهواء نتطلع بعين على النجوم لنمسكها فلا نستطيع وعين أخرى تنظر إلى الأرض خشية الوقوع عليها

لكم منا كل الشكر والتقدير

اخي الفاضل

السلام عليكم ورحمة الله وبركاته

قد تكون بعض الأمور غائبة عنك بارك الله بك

فأختكم زهره قد رحلت عنكم منذ زمن بعيد وقد لا تكون تعرف هذه المعلومة او هذا الخبر لأنني ادرير شبكتي النسائية " أنا مسلمة " راجع هذا الرابط

/index.php?showtopic=146311

وما تواجدي معكم في بعض الأوقات والمرور على المنتدى إلا لغرض التواصل فقط لا غير فأتمنى ان لا تظن انني عندما لا اجيب على بعض التساؤلات انه تهربا او عدم معرفه فلا يوجد شيء مستحيل وكل شيء يمكن تنفيذه في قواعد البيانات اكسيس .

اما بالنسبة لسؤالك عن نسخ قاعدة البيانات المفتوحه CopyToAnyWhere فكنت اتمنى انك قمت بمعاينة الكود الخاص بعملية النسخ لترى كيف يقوم الكود خطوة خطوه بتنفيذ هذا الأمر حيث يقوم الكود بعمل نسخة مشابهة تماما لنفس اسم القاعدة الحالية المفتوحة فإن كانت في نفس المجلد قام بتغيير اسمها وان كانت في مكان آخر قام بعملية انشاء قاعدة جديده بنفس اسم القاعدة الحالية ثم يقوم بتصدير جميع الجداول والنماذج والتقارير والإستعلامات الى القاعدة الجديده لهذا اذا اردت التأكد من ذلك قم بعمل هذه الخطوه وانظر بنفسك

قد يكون عدم المامك بما يجري في خلفية الكود هو الذي دفعك لكتابة هذه المشاركة .

اما بالنسبة لمشكلتك فهي متعددة الوجوه نظرا لأنه في المقام الأول ان قاعدة الجداول مرتبطة بقاعدة النماذج وايضا تكون مفتوحه اثناء عملية النسخ وحتى لو تم النسخ والقيام بعمل كود لهذا الغرض لقواعد البيانات المرتبطة فستبقى ايضا لديك مشكلة اعادة الربط بقاعدة النماذج حيث ان قاعدة النماذج مرتبطة بقاعدة الجداول في مكان معين فإن اختلف هذا الموضع فبالطبع ستحصل على خطا فوري نتيجة اختلاف موقع الإرتباط بين القاعدتين وفي هذه الحالة ستحتاج الى عدة اكواد لكي تقوم بإعادة الربط بين القاعدتين مما يعني انه لزاما عليك ان تقوم بحذف الجدالو المرتبطة في قاعدة النماذج اولا ثم تعيد الربط بقاعدة الجداول مرة اخرى بناء على موقعها الجديد في كل مره تقوم به بعملية النسخ لقاعدة الجداول فيما لو تغير موقعها عن ما هي موجده به في قاعدة الجداول .

لهذا بارك الله بك حتى تريح مخك من كل هذا العذاب يكفي ان تقوم بخطوة واحدة يدويه وهي الذهاب الى قاعدة الجداول وهي مغلقه وتقوم بعملية نسخها الى اي مكان تريده لكي تحتفظ بنسخة منها بدلا من عذاب الأكواد ووجع الرأس .