سخ ملف pdf من مجلد في السيرفر الى موقع جديد في السيرفر

[بن شجاع الدين]

رجو منكم المساعدة , اقوم حاليا بعمل قاعدة بيانات  خاصة وتواجهني مشكلة تتلخص في انه مطلوب اضافة ملف pdf  مرتبط برقم الفاتورة المكون من 10 ارقام , ملف ال pdf  يتم عمله من خلال ال ماسح الضوئي ويعطى اثناء المسح رقما مميزا هو رقم الفاتورة , ما احتاجة هو عمل زر امر يقوم بالتالي وحسب الترتيب :

1- نسخ الملف المطابق للرقم في السجل المحدد  من مجلد معين في ال سيرفر المحلي الى ملف اخر داخل السيرفر المحلي, المسار ثابت في الكود

2- عند طلب فتح الملف في اي وقت لاحق يتم فتحه من الموق الجديد الذي انتقل اليه.

3- اذا كان الملف غير موجود  تنبثق رسالة تقول ان الملف المطلوب غير موجود يرجا التاكد من رقم الملف.

4- يتغير زر الأمر الى اللون الأخضر اذا كان هناك ملف متصل ب السجل .

5- يتم ربط المسارات الى سجل - جدول محدد اسمه path وعند تغيير المسارات يمكن بسهوله تغييره من هذا السجل

ADD MOVE TO OPN FRM NEW FOLDR.rar

[jjafferr]

وعليكم السلام

 

1. نفترض الملف الحالي في \:C  والمجلد الجديد الى  \:E

للنسخ
FileCopy "Source Path And Name", "Destination Path And Name"
FileCopy "C:\myfile.pdf", "E:\Temp\File_With_New_Name.pdf"

لنقل الملف من مجلد الى آخر
Name "old path AND name" As "new path AND name"
Name "C:\myfile.pdf" As "E:\Temp\File_With_New_Name.pdf"

 

2 و 5 . عند طلب تشغيله:

application.followhyperlink "E:\Temp\File_With_New_Name.pdf"

3 و 4 . 

If Dir("E:\Temp\File_With_New_Name.pdf") <> "" Then
'الملف موجود، غير لون خلفية حقل النص الى اخضر
me.Field1.backcolor=rgb(0,255,0) 	'Green
Else
MsgBox "الملف غير موجود"
me.Field1.backcolor=rgb(255,0,0) 	'Red
End If

 

جعفر

[بن شجاع الدين]

شكرا جزيلا اخي حعفر ,

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

على افتراض ان الحقول ارقام متغيرة بالنسبة لحقول المقارنة المرتبطة بملفات ال pdf . ,والتي يكون عددها كبير جدا.

فيجب ان يون المسار ثابت بينما الملفات متغيره مرتبطة ب ال ID  المعرف

[jjafferr]

السلام عليكم أخي

 

انا انزلت المرفق ، ولكن لم افهم شئ 

اعطني شرح مفصل باسماء الحقول التي تريدني اتعامل معاها ، والخطوات ، واسم النموذج ووو

 

جعفر

[بن شجاع الدين]

شكرا جزيلا مجددا اخي حعفر  على تفاعلك ,

قمت بارفاق الملف مجددا مع بعض الأيضاحات واتمنى ان اكون قد وفقت فيها.

 

المرفقات

Move PDF file from A to B.rar

[بن شجاع الدين]

ملاحظة :

في الملف السابق الذي قمت بارفاقة الأمس  يوجد بعض الأكواد التي حاولت تطبيقها ولم انجح,

فيما عدا واحد والذي يقوم فقط بفتح الملف في المكان الذي هو موجود فيه  اصلا من خلال مسار موجود في الكود والذي يلزم لتغييره ان يتم تغييره من ال VBA ,وهوا ما ارغب فيه عهذه الشاشة ستكون محضورة على المستخدم النهائي  ولاكن يمكن تغييره من خلال واجهة اكسس في نموذج مرتبط بجدول.

كما ان هذا الكود لا يقوم بالطلبات لأخرى من نسخ الملف من المجلد المصر الى المجلد الهدف ....

[jjafferr]

تفضل

Option Compare Database

Private Sub cmd_Copy_From_Source_to_Destination_Click()

    Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1")
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF"
    
End Sub

Private Sub cmd_Open_the_File_from_Destination_Click()

    Dim strFilePath As String
  
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
    If Dir(strFilePath) <> "" Then
        Application.FollowHyperlink strFilePath
    Else
        MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!"
    End If

End Sub

Private Sub Form_Load()

    Dim strFilePath As String
  
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
    If Dir(strFilePath) <> "" Then
        'الملف موجود، غير لون خلفية الزر الى اخضر
        Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green
    Else
        'الملف غير موجود
        Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red
    End If
    
End Sub

 

جعفر

Copy PDF from A folder To B Folder.zip

[بن شجاع الدين]

شكرا جزيلا اخي جعفر,

الملف يعمل بشكل جيد ,

ولاكن هل بالأمكان ان يتم الأمر كله من خلال ايقونة واحدة؟

[jjafferr]

كيف زر واحد؟

شو الاوامر اللي تريدها تصير ، بالتسلسل؟

[بن شجاع الدين]

شكرا مجددا بلا حدود على تفاعلك اخي العزيز .والأوامر كما يلي :

1- نسخ الملف من المجلد المصدر  الى ال وجهه الهدف.بوضع المسارات كما هي في ملفك الأخير.

2- التاكد اذا كان هناك ملف مرتبط بالسجل في المجلد الهدف  تم ربطة من خلال الطلب رقم 1    و يتم فتحة بنفس الأيقونة .

3- بالطبع اذا كان الملف موجود في المجلد المصدر فيتم نسخه الى المجلد الهدف ويمكن فتحه من هناك في اي وقت طالما هو موجود.

3- اذا لم يكن هناك ملف بهذا الرقم ف تنبثق رسالة تفيد بعدم وجود ملف بهاذا الرقم في المصدر او الهدف.

[jjafferr]

 

وعليكم السلام

 

تفضل:

Private Sub cmd_Open_the_File_from_Destination_Click()

    Dim strFilePath As String
  
    Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1")
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
    If Dir(Source & "\" & Me.ID & ".PDF") <> "" Then
        FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF"
            
            'give the slow PCs wait time until copying is completed
            PauseTime = 2    ' Set duration.
            Start = Timer    ' Set start time.
            Do While Timer < Start + PauseTime
                DoEvents    ' Yield to other processes.
            Loop
        
        Application.FollowHyperlink strFilePath
    Else
        MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!"
    End If

End Sub

Private Sub Form_Load()

    Dim strFilePath As String
  
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
    If Dir(strFilePath) <> "" Then
        'الملف موجود، غير لون خلفية الزر الى اخضر
        Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green
    Else
        'الملف غير موجود
        Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red
    End If
    
End Sub

 

جعفر

584.1.Copy PDF from A folder To B Folder.accdb.zip

[بن شجاع الدين]

السلام عليكم اخي جعفر وعلى الجميع,

شكرا جزيلا وجزاك الله خيرا , الحمد لله وصلت الى المطلوب , والملف يعمل بشكل جيد.

[بن شجاع الدين]

عفوا اخي جعفر لا يزال هناك شيئ يحتاج تعديل  وهو انه عند الحاجة الى فتح الملف يتم فتحة من المجلد المصدر وليس من المجلد الذي تم نسخ الملف ال pdf اليه.

[jjafferr]

 

وعليكم السلام

 

لا ارى كيف ذلك ، فالكود يأخذ مسار المجلد الذي تم النسخ اليه:

Private Sub cmd_Open_the_File_from_Destination_Click()

...
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
...
        
        Application.FollowHyperlink strFilePath
...
End Sub

 

هل اخذت الكود والصقته ببرنامجك (يعني غير البرنامج الذي ارفقته انا) ؟

اذا فعلت ، فيجب عليك ان تضيف حقل ID للجدول bath ، بحيث:

  ID  = 1  لسجل الـ Source

  ID  = 2  لسجل الـ Destination

 

جعفر

[بن شجاع الدين]

مساء الخير اخ جعفر .

لا لم اغير شيء في الملف فتحته كما هو فقط غيرت المسارات .

تتم عمليه النقل وباقي الأحداث بشكل صحيح ولاكن الفتح يتم من المجلد المصدر فاذا قمت بحذف ملف ال pdf في الملف المصدر فلا يتم فتح الملف بالرغم من وجودة في ملف الهدف .

جرب بنفسك وتاكد

[jjafferr]

اذا حذفت الملف من الاصل ، فسيعطيك البرنامج رسالة بعدم وجود الشهادة ،

 

ولكن ولكي اثبت لك: 

احذف هذا السطر        
FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF"

واستبدله بهذا السطر
Name Source & "\" & Me.ID & ".PDF" As Destination & "\" & Me.ID & ".PDF"

 

هنا الكود لا يقوم بنسخ الملف من المصدر ، وانما بنقله من المصدر ،

وسوف يقوم بفتحه ،

ثم انظر في مجلد المصدر ، فلن تراه هناك ، بل ستراه في مجلد الهدف

 

جعفر

[بن شجاع الدين]

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

[jjafferr]

الآن فهمت الذي تريد عمله!!

 

اذا كان الملف موجود في المجلد الهدف ، اذن افتحه ،

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

واذا لم يتواجد في المجلدين ، اعطي رسالة الانذار بعدم وجود الشهادة:

Private Sub cmd_Open_the_File_from_Destination_Click()

    Dim strFilePath As String
  
    Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1")
    Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2")
    
    strFilePath = Destination & "\" & Me.ID & ".PDF"
    
    If Dir(strFilePath) <> "" Then
        Application.FollowHyperlink strFilePath
    
    ElseIf Dir(Source & "\" & Me.ID & ".PDF") <> "" Then
        FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF"
            
            'give the slow PCs wait time until copying is completed
            PauseTime = 2    ' Set duration.
            Start = Timer    ' Set start time.
            Do While Timer < Start + PauseTime
                DoEvents    ' Yield to other processes.
            Loop
        
        Application.FollowHyperlink strFilePath
    Else
        MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!"
    End If

End Sub

 

584.2.Copy PDF from A folder To B Folder.accdb.zip

[بن شجاع الدين]

شكرا الان يعمل بالشكل المطلوب

[بن شجاع الدين]

المعذرة اخي جعفر , ظهرت لدي مشكلة , وهي عند النقر على زر فتح الملف تضهر رسالة طلب التاكيد (موافق - الغاء) وعند النقر على الغاء يحصل خطا ويطلب بتعديل الخطاء في VBAفما هو الحل لها؟

[jjafferr]

وعليكم السلام

 

المشكلة في امر فتح الملفات:

Application.FollowHyperlink strFilePath

 

ويمكنك اتباع احد هذه الطرق لإستبداله بأمر آخر:

http://allenbrowne.com/func-GoHyperlink.html

http://access.mvps.org/access/api/api0018.htm

http://access.mvps.org/access/api/api0004.htm

http://www.utteraccess.com/wiki/index.php/Opening_Files_From_Access

 

جعفر

[بن شجاع الدين]

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

[jjafferr]

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

 

جعفر