كود لاستعراض المجلدات و الحصول على مسار المجلد

[ابراهيم - ابو ريان]

اريد استعراض المجلدات ومن ثم اختيار مسار المجلد فقط في مربع نص

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

فهل من يساعدني جزاكم الله خيرا

[ابراهيم - ابو ريان]

لا زلنا بانتظار مساعدة الاخوة الاعزاء

[rudwan]

اريد استعراض المجلدات ومن ثم اختيار مسار المجلد فقط في مربع نص

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

فهل من يساعدني جزاكم الله خيرا

أولا اختلط المطلوب في سؤالك : هل تريد مسار المجلد أم مسار الملف ؟ فقد ذكرت المطلبين في وقت واحد

ثانيا ماهو الكود الذي لديك حتى لاتتكرر الاجابة على كود موجود عندك

[ابراهيم - ابو ريان]

اخي جزاك الله خيرا على ردك الكريم

الكود الذي لدي في المرفق يقوم باخذ مسار الملف اما طلبي فهو ان ياخذ مسار المجلد فقط

قد لا تستطيع تحميل المجلد لوجود مشكلة في التحميل من المنتدى

اذن فالكود الذي لدي هو التالي

Dim ofn As OpenFileName
    ofn.lStructSize = Len(ofn)
    'ofn.hwndOwner = Me.Hwnd
    'ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "Mdb Files (*.mdb)" + Chr$(0) + "*.mdb" + Chr$(0) + "Mde Files (*.mde)" + Chr$(0) + "*.mde" + Chr$(0)
        ofn.lpstrFile = Space$(254)
        ofn.nMaxFile = 255
        ofn.lpstrFileTitle = Space$(254)
        ofn.nMaxFileTitle = 255
        ofn.lpstrInitialDir = CurDir
        ofn.lpstrTitle = " MT Software "
        ofn.flags = 0
        Dim A
        A = GetOpenFileName(ofn)
        If (A) Then
                Me![oldfile] = Trim$(ofn.lpstrFile)
                  
                  
              
              
                'MsgBox "File to Open: " + Trim$(ofn.lpstrFile)
        Else
                MsgBox "Cancel was pressed"
        End If
    Exit Sub

CmdBrowseErrHandler:
If Err.Number = 32755 Then
 MsgBox " You did not change the file name ", 64, "Alert Message "
ElseIf Err.Number = 20477 Then
 MsgBox " Invalid file name  ", 16, "Alert Message "
Else
MsgBox Str(Err.Number) + Err.Description
End If
Exit Sub

________.rar

تم تعديل أبريل 22, 2008 بواسطه ابراهيم - ابو ريان

[rudwan]

انسخ الكود التالي في وحدة نمظية جديدة

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseDirectory(szDialogTitle As String) As String
On Error GoTo Err_BrowseDirectory

    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer
    
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseDirectory = Left$(szPath, wPos - 1)
    Else
        BrowseDirectory = ""
    End If

Exit_BrowseDirectory:
    Exit Function

Err_BrowseDirectory:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_BrowseDirectory

End Function

الآن ضع الكود التالي في حدث عند النقر لزر أمر ليضع مسار المجلد في مربع نص اسمه : tbDirectoryName

On Error GoTo Err_bBrowse_Click
    
    Dim sDirectoryName As String
    
   ' Me.tbHidden.SetFocus
    
    sDirectoryName = BrowseDirectory("Find and select where to export the report files.")
    
    tbDirectoryName = sDirectoryName
    
Exit_bBrowse_Click:
    Exit Sub
    
Err_bBrowse_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_bBrowse_Click

[اسلام سيد]

المشكه انه لا يقبل على 64 بايت

[jjafferr]

اخي اسلام 🙂

 

هذا الموضوع من 12 سنه ، فلا تتوقع رد من اصحابه !!

هذا الرابط سيفيدك :

اجعل برنامجك يعمل على النواتين 32بت و 64بت - قسم الأكسيس Access - أوفيسنا (officena.net)

 

جعفر

[اسلام سيد]

4 دقائق مضت, jjafferr said:

اخي اسلام 🙂

 

هذا الموضوع من 12 سنه ، فلا تتوقع رد من اصحابه !!

هذا الرابط سيفيدك :

اجعل برنامجك يعمل على النواتين 32بت و 64بت - قسم الأكسيس Access - أوفيسنا (officena.net)

 

جعفر

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

[jjafferr]

لهذا السبب ، الطريقة الافضل لك ، هي عمل سؤال جديد ، حتى يستطيع الاعضاء المعاصرون من الرد على سؤالك ، وبسرعة 🙂

 

جعفر