نسخ ملف على كمبيوتر الشبكة

[hantantin]

اخوتي الكرام

لدي قاعدة بيانات منقسمة لجداول(MR.accdb) وواجهة موزعة على كمبيوترات الشبكة...عن طريق الواجهة يمكنني نسخ ملف محدد داخل مجلد المشاركة

FileCopy CurrentProject.Path & "\MR.accdb", CurrentProject.Path & "\source\MR.accdb"

سؤالي :هل ممكن ان انسخ نفس الملف على الهارد ديسك مثلا d:\ الخاص بالكمبيوتر الاساسي  بغض النظر ان كان العمل على الكمبيوتر الاساسي او كمبيوتر اخر على الشبكة

وهل يمكن ايضا انشاء مجلد ووضع الملف بداخله وما هو الكود الخاص بانشاء المجلد بهذه الحالة

طبعا الهارد D لا يوجد به اذن مشاركة 

وشكرا

 

 

[د.كاف يار]

جرب هذا الكود اخي الكريم

مع العلم بأن مسار قاعدة البيانات الحالية يكون بهذا الشكل

مسار قاعدة البيانات الحالية
MyPath=CurrentProject.Path 

لمعرفة اسم قاعدة البيانات الحالية 
CurrentProject.FullName

 

الأن نبدء بالكود الخاص بنسخ الملف 

- اضف مربع نص و لنجعل اسمه xFile 

- اضف ازرار و اعطه اسم FileDialog أو اي اسم تريده و ضع الكود التالي في حدث عند النقر لاختيار الملف المراد نسخه

Dim Addfile As Object
Set Addfile = Application.FileDialog(3)
With Addfile
  .AllowMultiSelect = False
  .InitialFileName = ""
  .Filters.Clear
  .Filters.Add "All Files", "*.*"
  If .Show = True Then
      
      xFile = Trim(.SelectedItems(1))
      

      Else
      Exit Sub
  End If
End With

- ضع ازرار أخر و اعطه اسم مثلا | نسخ الملف المحدد | و ضع الكود ادناه في حدث عند الفتح

Dim MyFile, DstFile As String
Dim Syso As Object
On Error GoTo errorhandle


MyFile = "مسار الملف المراد نسخه"
DstFile = "D:\\" مسار الملف الجديد 

DBEngine.Idle

Set Syso = CreateObject("Scripting.FileSystemObject")
Syso.copyfile MyFile, DstFile
Set Syso = Nothing

MsgBox "تم نسخ الملف بنجاح" , vbMsgBoxRight + vbOKOnly, "تاكيد"

errorhandleexit:
        Exit Sub
errorhandle:
        MsgBox Err.Description
        Resume errorhandleexit

Exit Sub
ErrH:
Select Case Err.Number
End Select

 

و يمكن وضع مربع نص اخر لوضع مسار الملف الجديد و جعله ارتباط تشعبي ليسهل الوصول اليه