اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


HaniMoursi
إذهب إلى أفضل إجابة Solved by ابوخليل,

الردود الموصى بها

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

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

تم تعديل بواسطه HaniMoursi
توضيح للمطلوب
رابط هذا التعليق
شارك

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

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

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

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

او

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

 

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

رابط هذا التعليق
شارك

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

او

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

 

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

تم تعديل بواسطه 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

 

تم تعديل بواسطه ابوخليل
تنسيق الكود
رابط هذا التعليق
شارك

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
 

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

link.jpg

رابط هذا التعليق
شارك

سيصبح هكذا

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

  • Like 1
رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

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 المرفق يفتح طبيعي

رسالة خطأ حال عدم الاضافه.jpg

رساله تحذيريه عند فتح المرفق.jpg

تم تعديل بواسطه HaniMoursi
رابط هذا التعليق
شارك

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

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

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

On Error Resume Next

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

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

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


Exit_ErrHandler:
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume Exit_ErrHandler

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

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

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information