تتبع ملفات pdf يتم حفظها داخل فولدرات مختلفة

[figo82eg]

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

وما اريده هو عند الضغط على زر بالنموذج يتم فتح ملف pdf المرقم بنفس الرقم بالنموذج

مرفق مثال لما اريد

ارشيف.rar

[figo82eg]

ارجو من اساتذتى الكرام مساعدتى

[Moosak]

أهلا بك أخي figo82eg 🙂 

تم عمل المطلوب ،،، وهو على جزئين :

1 - كود لإنشاء المجلدات المطلوبة موضوع على الزر الخاص بالحقل CRN :

Public Sub CreatFolders()
Dim Fldr1 As String, Fldr2 As String, Fldr3 As String, Fldr4 As String, Fldr5 As String
Dim DBPath As String
Dim D As String: D = "\"

'فحص ما إذا كانت جميع الخانات معبئة
If IsNull(Text10) Or Text10 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Text10.SetFocus: Exit Sub
If IsNull(Me.نوع_الخطاب) Or Me.نوع_الخطاب = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.نوع_الخطاب.SetFocus: Exit Sub
If IsNull(Me.Combo1) Or Me.Combo1 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.Combo1.SetFocus: Exit Sub
If IsNull(Me.Combo2) Or Me.Combo2 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.Combo2.SetFocus: Exit Sub
If IsNull(Me.crn) Or Me.crn = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.crn.SetFocus: Exit Sub

Fldr1 = Me.Text10
Fldr2 = Me.نوع_الخطاب
Fldr3 = Me.Combo1
Fldr4 = Me.Combo2
Fldr5 = Me.crn

'إنشاء المجلدات
DBPath = BECurrentPath
MkDir (DBPath & D & Fldr1)
MkDir (DBPath & D & Fldr1 & D & Fldr2)
MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3)
MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3 & D & Fldr4)
MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3 & D & Fldr4 & D & Fldr5)

MsgBox "تم إنشاء المجلدات بنجاح"
End Sub

2- كود لإحضار الملفات أو الصور على زر مسار الصورة ( ينسخ لك الصورة في المجلد المطلوب ، ثم يعرضها لك) :

Private Sub cmdAdd_Click()

Dim file As String
Dim fileName As String

Dim DesPath As String
Dim D As String: D = "\"


DesPath = (BECurrentPath & D & [Text10] & D & [نوع الخطاب] & D & [Combo1] & D & [Combo2] & D & [crn] & D)

If IsFileExists(DesPath) = False Then Call CreatFolders

file = selectFile
If IsNull(file) Or file = "" Then Exit Sub

fileName = GetFileName(file)
DesPath = DesPath & fileName

FileCopy file, DesPath

Me.ImagePath = fileName
Me.ImageFrame.Requery

MsgBox "تم إضافة الملف بنجاح"

End Sub

 

 

طبعا تم الاستعانة بعدة دوال عامة جميعها موجودة في الموديول basBrowseFiles

جرب وأخبرني بالنتيجة 🙂 

 

ارشيف - Moosak.rar

[figo82eg]

@Moosak اشكرك استاذى الكريم على سعة صدرك 

ولكن الجزء الاول الخاص بإنشاء الفولدرات تمام

ولكن الجزء الثانى لما اريده هو ( فتح ملف بصيغة pdf موجود بنفس مسار الفولدرات التى تم انشائها من خلال الجزء الاول من الكود وليس عرضها فى نفس النموذج )

اريد ان يتم فتحها من خلال اى برنامج عرض ملفات pdf  اذا كان ملف pdf محفوظ فى نفس المسار الذى انشائها واذا لم يكن موجود فى نفس المسار يتم نسخه الى المسار وفتحه.

تم تعديل يونيو 18, 2022 بواسطه figo82eg

[figo82eg]

@Moosak @rockjone33 عند تنفيذ حل استاذى @Moosak فى برنامجى يتظهر لدى هذه الرسالة على الرغم من نجاحها فى المثال المرفق الذى تم تنفيذه 

[Moosak]

46 دقائق مضت, figo82eg said:

تظهر لدى هذه الرسالة

 

9 ساعات مضت, Moosak said:

تم الاستعانة بعدة دوال عامة جميعها موجودة في الموديول basBrowseFiles

أخي  figo82eg  لا تنسى نقل الموديول basBrowseFiles إلى برنامجك 🙂 

[figo82eg]

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

[figo82eg]

@rockjone33بارك الله فيك اخى الكريم وزادك الله من فضله وعلمه 

[figo82eg]

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

Private Sub OpenFile_Click()
Dim File_Path As String, File_Name As String, Name_Path As String
   File_Path = Application.CurrentProject.Path & "\وارد\"

   File_Name = Dir(File_Path & Me.crn & "*.pdf")
   
   If File_Name = "" Then
      MsgBox "المستند غير محفوظ"
      Exit Sub
   End If
   While File_Name <> ""
      Name_Path = File_Path & File_Name
      Application.FollowHyperlink Name_Path
      File_Name = Dir()
   Wend
End Sub

ويتم تغير مسار فتح الملف بالمسار التالى 


Application.CurrentProject.Path & D & [Text10] & D & [نوع_الخطاب] & D & [Combo1] & D & [crn] & D)

 

[figo82eg]

المطلوب زر يفتح ملف pdf فى مسار الوارد او الصادر على اى مستعرض pdf بمجرد الصغط عليه .

حيث ان ملف pdf موجود ومرقم برقم crn داخل مسار الوارد او الصادر .

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

9 ساعات مضت, figo82eg said:

Private Sub OpenFile_Click()
Dim File_Path As String, File_Name As String, Name_Path As String
   File_Path = Application.CurrentProject.Path & "\وارد\"

   File_Name = Dir(File_Path & Me.crn & "*.pdf")
   
   If File_Name = "" Then
      MsgBox "المستند غير محفوظ"
      Exit Sub
   End If
   While File_Name <> ""
      Name_Path = File_Path & File_Name
      Application.FollowHyperlink Name_Path
      File_Name = Dir()
   Wend
End Sub

 

[Barna]

جرب كده ....... 

Private Sub OpenFile_Click()
Dim File_Path As String, File_Name As String, Name_Path As String
   File_Path = Application.CurrentProject.Path & "\وارد\"

   File_Name = Dir(File_Path & Me.crn & "*.pdf")
   
   If File_Name = "" Then
      MsgBox "المستند غير محفوظ"
      Exit Sub
   End If
   While File_Name <> ""
      Name_Path = File_Name
      Application.FollowHyperlink Name_Path
      File_Name = Dir()
   Wend
End Sub

 

[figo82eg]

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

بمعنى مسار الملف يتم تحديده بناءا على الملفات الى انشائها البرنامج كما هو بمثال استاذنا @Moosak واريد ان يتم فتحها اذا كانت الملفات موجودة بنفس مسار  حقل crn حيث يكون ملف pdf داخله بنفس رقم crn

ومرفق مثال لما اريد

ارشيف - Moosak.rar

تم تعديل يونيو 20, 2022 بواسطه figo82eg

[Moosak]

تفضل أخي figo82eg  🙂 

Private Sub OpenPDFBtn_Click()
Dim DesPath As String
Dim D As String: D = "\"

DesPath = (BECurrentPath & D & [Text10] & D & [نوع الخطاب] & D & [Combo1] & D & [Combo2] & D & [crn] & D & [crn] & ".pdf")
'Debug.Print DesPath

If IsFileExists(DesPath) Then
    FollowHyperlink DesPath
Else
    MsgBox "لم يتم العثور على الملف", vbOKOnly, "تنبيه"
End If
End Sub

 

ارشيف - Moosak.rar

[figo82eg]

4 ساعات مضت, Moosak said:

تفضل أخي figo82eg  🙂 

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

[Moosak]

57 دقائق مضت, figo82eg said:

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

اللهم آمين .. وإياكم أخي العزيز 😊🌹