تحديد اسم المرفق فقط وليس المسار

[HaniMoursi]

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

تحديد اسم المرفق فقط.zip

تم تعديل فبراير 9, 2023 بواسطه HaniMoursi
توضيح للمطلوب

[ابوخليل]

Right(a, Len(a) - InStrRev(a, "\"))

 

تحديد اسم المرفق.rar

[jjafferr]

او

mid(a, InStrRev(a, "\") +1)

 

[HaniMoursi]

5 ساعات مضت, ابوخليل said:

Right(a, Len(a) - InStrRev(a, "\"))

 

تحديد اسم المرفق.rar 256.86 kB · 3 downloads

المحترم استاذنا الفاضل ابوخليل ربنا يعزك متشكر جدا جدا

وعندي سؤال انا بعرف شويا بالبرمجه وبقوم بعمل بعض البرامج لكن كيف اتعلم وهل هناك كتب او مواقع او معاهد لتعليم البرمجه تنصحنى بها

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

او

mid(a, InStrRev(a, "\") +1)

 

المحترم اخى المهندس جعفر شكرا جدا جدا لمرورك الكريم

[HaniMoursi]

5 ساعات مضت, jjafferr said:

او

mid(a, InStrRev(a, "\") +1)

 

اخي الكريم جعفر هل بالإمكان + اسم الملف اضيف اسم الفولدر الموجود في وهناك مرفق اوصل له بعد 2 او 3 ملفات مع العلم لا احتاج المسار بالكامل 

تم تعديل فبراير 9, 2023 بواسطه HaniMoursi

[ابوخليل]

شوف الموضوع هذا تجد فيه حاجتك ، سواء تريد المجلد الاول او الثاني ...

 

[HaniMoursi]

44 دقائق مضت, ابوخليل said:

شوف الموضوع هذا تجد فيه حاجتك ، سواء تريد المجلد الاول او الثاني ...

 

اهلين اخي الكريم بوخليل 

هل كود الاضافه هيكون بهذا الشكل

 

Private Sub CmdView_Click()
Dim a
a = Choose_File(FolderPath(Nz(Me.LetterLink, "")))
If Nz(a, "") <> "" Then Me.LetterLink = Right(a, Len(a) - InStrRev(a, "\"))

Dim i, ii
Call werfolder
i = Right(Me.LetterLink, Len(Me.LetterLink) - InStrRev(Me.LetterLink, "\"))
ii = CurrentProject.path & "\" & getfldr2 & "\" & getfldr1 & "\" & i
plink = ii
DoCmd.SetWarnings False

End Sub
Sub werfolder()
Dim fileName As String
fileName = Me.LetterLink
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
getfldr1 = (vPathSplitter(UBound(vPathSplitter) - 1))
getfldr2 = (vPathSplitter(UBound(vPathSplitter) - 2))
End Sub

 

تم تعديل فبراير 9, 2023 بواسطه ابوخليل
تنسيق الكود

[HaniMoursi]

2 دقائق مضت, HaniMoursi said:

اهلين اخي الكريم بوخليل 

هل كود الاضافه هيكون بهذا الشكل

 

Private Sub CmdView_Click()
Dim a
a = Choose_File(FolderPath(Nz(Me.LetterLink, "")))
If Nz(a, "") <> "" Then Me.LetterLink = Right(a, Len(a) - InStrRev(a, "\"))

Dim i, ii
Call werfolder
i = Right(Me.LetterLink, Len(Me.LetterLink) - InStrRev(Me.LetterLink, "\"))
ii = CurrentProject.path & "\" & getfldr2 & "\" & getfldr1 & "\" & i
plink = ii
DoCmd.SetWarnings False

End Sub
Sub werfolder()
Dim fileName As String
fileName = Me.LetterLink
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
getfldr1 = (vPathSplitter(UBound(vPathSplitter) - 1))
getfldr2 = (vPathSplitter(UBound(vPathSplitter) - 2))
End Sub
 

كما في الصوره لا اريد اظهار الجزء الذي بالوان الاسود في المسار

[ابوخليل]

سيصبح هكذا

Dim a, werldr1, werldr2 As String
a = Choose_File(FolderPath(Nz(Me.AttachmentPath, "")))
Dim fileName As String
fileName = a
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
werldr1 = (vPathSplitter(UBound(vPathSplitter) - 1))
werldr2 = (vPathSplitter(UBound(vPathSplitter) - 2))
If Nz(a, "") <> "" Then Me.AttachmentPath = werldr2 & "\" & werldr1 & "\" & Right(a, Len(a) - InStrRev(a, "\"))
If Not IsNull([AttachmentPath]) Then
MsgBox "تم إضاف اسم المرفق بنجاح", vbInformation, "إضافة مرفقات"
Else
MsgBox "عفواً لم يتم تحديد المرفقات", vbInformation, "لا يوجد مرفقات لهذه الموضوع"
End If

آمل ان تدرس الكود جيدا 

تحديد اسم المرفق2.rar

[HaniMoursi]

4 ساعات مضت, ابوخليل said:

سيصبح هكذا

Dim a, werldr1, werldr2 As String
a = Choose_File(FolderPath(Nz(Me.AttachmentPath, "")))
Dim fileName As String
fileName = a
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
werldr1 = (vPathSplitter(UBound(vPathSplitter) - 1))
werldr2 = (vPathSplitter(UBound(vPathSplitter) - 2))
If Nz(a, "") <> "" Then Me.AttachmentPath = werldr2 & "\" & werldr1 & "\" & Right(a, Len(a) - InStrRev(a, "\"))
If Not IsNull([AttachmentPath]) Then
MsgBox "تم إضاف اسم المرفق بنجاح", vbInformation, "إضافة مرفقات"
Else
MsgBox "عفواً لم يتم تحديد المرفقات", vbInformation, "لا يوجد مرفقات لهذه الموضوع"
End If

آمل ان تدرس الكود جيدا 

تحديد اسم المرفق2.rar 24.36 kB · 4 downloads

تسلم يدك استاذنا الفاضل 😍

[HaniMoursi]

17 ساعات مضت, ابوخليل said:

سيصبح هكذا

Dim a, werldr1, werldr2 As String
a = Choose_File(FolderPath(Nz(Me.AttachmentPath, "")))
Dim fileName As String
fileName = a
Dim vPathSplitter As Variant
vPathSplitter = Split(fileName, "\")
werldr1 = (vPathSplitter(UBound(vPathSplitter) - 1))
werldr2 = (vPathSplitter(UBound(vPathSplitter) - 2))
If Nz(a, "") <> "" Then Me.AttachmentPath = werldr2 & "\" & werldr1 & "\" & Right(a, Len(a) - InStrRev(a, "\"))
If Not IsNull([AttachmentPath]) Then
MsgBox "تم إضاف اسم المرفق بنجاح", vbInformation, "إضافة مرفقات"
Else
MsgBox "عفواً لم يتم تحديد المرفقات", vbInformation, "لا يوجد مرفقات لهذه الموضوع"
End If

آمل ان تدرس الكود جيدا 

تحديد اسم المرفق2.rar 24.36 kB · 6 downloads

استاذنا ابوخليل في ملاحظه بسيطه وهي كالتالي 

عندما اضغط لإختيار مرفق وكل شيئ بيكون تمام لكن في حال الإلغاء ولم اختار المرفق تظهر هذه الرساله وايضا عند فتح المرفق تظهر رسائل تحذيريه كما هو موضح بالصوره المرفقه ايضا مع العلم عند اختيار ok المرفق يفتح طبيعي

تم تعديل فبراير 10, 2023 بواسطه HaniMoursi

[ابوخليل]

بالنسبة للصورتين الاخيرتين فهي بسبب الحماية في اوفيس ، يمكنك تخفيض امان الماكرو فتختفي هذه الرسائل

اما الرسالة الاولى فيوجد طريقتين لتجاوز الخطأ

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

On Error Resume Next

ووظيفة هذا السطر انه اذا وجد خطأ يقفز لما بعده ويكمل تنفيذ الاجراء

الثانية : اذا الكود يشتمل على جمل برمجية كل واحدة منها احتمال يصدر الخطأ منها فيجب ان تضع العبارة التالية

On Error GoTo ErrHandler
  
'>>>>> الصق كودك هنا


Exit_ErrHandler:
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume Exit_ErrHandler

والوظيفة هنا تدلك على سبب الخطأ

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

 

[AbuuAhmed]

دالة InStrRev خيار آخر لفصل اسم الملف من اسم المسار الكامل.