Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hỏi] Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
#1
Mình muốn tạo một FileDialog hay CommonDialog trong access 2003 mà không biết tạo bạn nào biết hướng dẫn mình phát Mình cảm ơn
Chữ ký của ngochuong279 Xin chào, mình là ngochuong279, Tham gia http://thuthuataccess.com/forum từ ngày 11-11 -13.
Reply
Những người đã cảm ơn
#2
Nếu bạn biết tiếng Anh, bạn nên tham khảo bài viết này... đơn giản là copy code và sử dụng
http://access.mvps.org/access/api/api0001.htm
Chiều tôi sẽ viết một Class để dùng cho tiện, nếu bạn cần, có thể tham khảo!
Đây tôi đã tạo ra một Module để dùng, bạn chỉ cần gọi GetFileOpen hoặc GetFileSave Hoặc GetBrowseFolder... với các tham số là có được cái như ý!
http://www.sfdp.net/thuthuataccess/thuth...ects=0&d=1
Chúc vui vẻ!
Chữ ký của paulsteigel ====================
Quốc gia hưng vong
Thất phu hữu trách
====================
Reply
Những người đã cảm ơn Xuân Thanh , haquocquan , conmeo , MatTroiNguQuen , maidinhdan , Minh Tiên
#3
Cảm ơn bác Ngọc đã chia sẻ  015

Hôm nay có dịp vọc cái Module trên mới phát hiện nMaxFile = 256 là không đủ cho trường hợp chọn ALLOWMULTISELECT.
 Để fix lỗi trên MTNQ thêm vào MAX_BUFFER  = 50 * MAX_PATH (MAX_PATH = 260 theo như bác đã thiết đặt ). Như vậy ta có thể chọn được khoảng 250 tập tin với độ dài trung bình của tên mỗi tập tin là 50 ký tự. Đồng thời thêm vào bẫy lỗi cho trường hợp tổng độ dài tên các tập tin được chọn vượt quá giới hạn cho phép

Mã:
'***************** Code Start **************
' This code was originally written by Ken Getz and I made it as a class wrapper
' It is not to be altered or distributed, 'except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
Private Type tagOPENFILENAME
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   Flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type

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

Private Declare Function GetOpenFile Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function GetSaveFile Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

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

' modBrowseFolder
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

Private Const MAX_PATH = 260 ' Windows mandated
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10

Private Const MAX_BUFFER As Long = 50 * MAX_PATH
'This MAX_BUFFER value allows you to select approx 250 files with an average length of 50 characters.
Private Const FNERR_BUFFERTOOSMALL = &H3003
'The function was provided with a filename buffer which was too small.
Private Const FNERR_INVALIDFILENAME = &H3002
'The function was provided with or received an invalid filename.

' You won't use these.
'Private Const OFN_ENABLEHOOK = &H20
'Private Const OFN_ENABLETEMPLATE = &H40
'Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000

' New for Windows 95
Private Const OFN_EXPLORER = &H80000
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000

Function TestIt()
   Dim strFilter As String
   Dim lngFlags As Long
   strFilter = AddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", "*.MDA;*.MDB")
   strFilter = AddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
   strFilter = AddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
   strFilter = AddFilterItem(strFilter, "All Files (*.*)", "*.*")

   ' Uncomment this line to try the example
   ' allowing multiple file names:
   ' lngFlags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER

   Dim result As Variant

   result = GetFileSave(InitialDir:="C:\", Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, DialogTitle:="Hello! Open Me!")

   If lngFlags And OFN_ALLOWMULTISELECT Then
       If isArray(result) Then
           Dim i As Integer
           For i = 0 To UBound(result)
               VBA.MsgBox result(i)
           Next i
       Else
           VBA.MsgBox result
       End If
   Else
       VBA.MsgBox result
   End If

   ' Since you passed in a variable for lngFlags,
   ' the function places the output flags value in the variable.
   Debug.Print Hex(lngFlags)
End Function

Function GetBrowseFolder(Optional ByVal DialogTitle As String) As String
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   ' BrowseFolder
   ' This displays the standard Windows Browse Folder dialog. It returns
   ' the complete path name of the selected folder or vbNullString if the
   ' user cancelled.
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
   If DialogTitle = vbNullString Then DialogTitle = "Select A Folder"
   
   Dim uBrowseInfo As BROWSEINFO
   Dim szBuffer As String
   Dim lID As Long
   Dim lRet As Long
   
   With uBrowseInfo
       .hOwner = 0
       .pidlRoot = 0
       .pszDisplayName = String$(MAX_PATH, vbNullChar)
       .lpszINSTRUCTIONS = DialogTitle
       .ulFlags = BIF_RETURNONLYFSDIRS ' + BIF_USENEWUI
       .lpfn = 0
   End With
   szBuffer = String$(MAX_PATH, vbNullChar)
   lID = SHBrowseForFolderA(uBrowseInfo)
   
   If lID Then
       ''' Retrieve the path string.
       lRet = SHGetPathFromIDListA(lID, szBuffer)
       If lRet Then
           GetBrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
       End If
   End If
End Function
Function GetFileOpen(Optional varDirectory As Variant, Optional varTitleForDialog As Variant, _
   Optional strFilter As String, Optional blnMulti As Boolean) As Variant

   Dim lngFlags As Long
   Dim varFileName As Variant

   If blnMulti Then
       lngFlags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
   Else
       lngFlags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_NOCHANGEDIR
   End If
   
   If IsMissing(varDirectory) Then varDirectory = ""
   
   If IsMissing(varTitleForDialog) Then varTitleForDialog = ""
   
   If strFilter <> "" Then
       strFilter = AddFilterItem("", "File Exts(" & strFilter & ")", strFilter)
   Else
       strFilter = AddFilterItem(strFilter, "All Files (*.*)", "*.*")
   End If
   
   varFileName = GetFileSave( _
                   OpenFile:=True, _
                   InitialDir:=varDirectory, _
                   Filter:=strFilter, _
                   Flags:=lngFlags, _
                   DialogTitle:=varTitleForDialog)
   
   If Not isArray(varFileName) Then
       If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName)
   End If
   GetFileOpen = varFileName
   
End Function

Function GetFileSave( _
           Optional ByRef Flags As Variant, _
           Optional ByVal InitialDir As Variant, _
           Optional ByVal Filter As Variant, _
           Optional ByVal FilterIndex As Variant, _
           Optional ByVal DefaultExt As Variant, _
           Optional ByVal FileName As Variant, _
           Optional ByVal DialogTitle As Variant, _
           Optional ByVal hwnd As Variant, _
           Optional ByVal OpenFile As Variant) As Variant
   
   Dim OFN As tagOPENFILENAME
   Dim strFileName As String
   Dim strFileTitle As String
   Dim fResult As Boolean
   Dim Errcode As Long
   
   ' Give the dialog a caption title.
   If IsMissing(InitialDir) Then InitialDir = CurDir
   If IsMissing(Filter) Then Filter = ""
   If IsMissing(FilterIndex) Then FilterIndex = 1
   If IsMissing(Flags) Then Flags = 0&
   If IsMissing(DefaultExt) Then DefaultExt = ""
   If IsMissing(FileName) Then FileName = ""
   If IsMissing(DialogTitle) Then DialogTitle = ""
   If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
   If IsMissing(OpenFile) Then OpenFile = True
   
   ' Allocate string space for the returned strings.
   strFileName = Left(FileName & String(256, 0), 256)
   strFileTitle = String(256, 0)
   
   ' Set up the data structure before you call the function
   With OFN
       .lStructSize = Len(OFN)
       .hwndOwner = hwnd
       .strFilter = Filter
       .nFilterIndex = FilterIndex
       '.nMaxFile = Len(strFileName)
       '.strFile = strFileName
       .nMaxFile = IIf(Flags And OFN_ALLOWMULTISELECT, MAX_BUFFER, MAX_PATH)
       .strFile = strFileName & String(.nMaxFile - Len(strFileName), 0)
       .nMaxFileTitle = Len(strFileTitle)
       .strFileTitle = strFileTitle
       .strTitle = DialogTitle
       .Flags = Flags
       .strDefExt = DefaultExt
       .strInitialDir = InitialDir
       ' Didn't think most people would want to deal with
       ' these options.
       .hInstance = 0
       '.strCustomFilter = ""
       '.nMaxCustFilter = 0
       .lpfnHook = 0
       'New for NT 4.0
       .strCustomFilter = String(255, 0)
       .nMaxCustFilter = 255
   End With
   ' This will pass the desired data structure to the
   ' Windows API, which will in turn it uses to display
   ' the Open/Save As Dialog.
   If OpenFile Then
       fResult = GetOpenFile(OFN)
   Else
       fResult = GetSaveFile(OFN)
   End If

   ' The function call filled in the strFileTitle member
   ' of the structure. You'll have to write special code
   ' to retrieve that if you're interested.
   If fResult Then
       ' You might care to check the Flags member of the
       ' structure to get information about the chosen file.
       ' In this example, if you bothered to pass in a
       ' value for Flags, we'll fill it in with the outgoing
       ' Flags value.
       
       If Not IsMissing(Flags) Then Flags = OFN.Flags
       If Flags And OFN_ALLOWMULTISELECT Then
           Debug.Print "werwqewqeq"
           ' Return the full array.
           Dim items As Variant
           Dim value As String
           value = OFN.strFile
           ' Get rid of empty items:
           Dim i As Integer
           For i = Len(value) To 1 Step -1
             If Mid$(value, i, 1) <> Chr$(0) Then
               Exit For
             End If
           Next i
           value = Mid(value, 1, i)

           ' Break the list up at null characters:
           items = Split(value, Chr(0))

           ' Loop through the items in the "array",
           ' and build full file names:
           Dim numItems As Integer
           Dim result() As String

           numItems = UBound(items) + 1
           If numItems > 1 Then
               ReDim result(0 To numItems - 2)
               For i = 1 To numItems - 1
                   result(i - 1) = FixPath(items(0)) & items(i)
               Next i
               GetFileSave = result
           Else
               ' If you only select a single item,
               ' Windows just places it in item 0.
               GetFileSave = items(0)
           End If
       Else
           GetFileSave = TrimNull(OFN.strFile)
       End If
   Else
       GetFileSave = vbNullString
       Errcode = CommDlgExtendedError()  ' get the error code for GetOpenFileName
       Select Case Errcode
           Case FNERR_BUFFERTOOSMALL
               MsgBox "Tong so ky tu cua ten cac tap tin vuot qua gioi han cho phep"
           Case FNERR_INVALIDFILENAME
               MsgBox "Ten tap tin khong hop le"
           Case Else
               If Errcode <> 0 Then Debug.Print Errcode
       End Select
       
   End If
End Function

Function AddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String

   ' Tack a new chunk onto the file filter.
   ' That is, take the old value, stick onto it the description,
   ' (like "Databases"), a null character, the skeleton
   ' (like "*.mdb;*.mda") and a final null character.

   If IsMissing(varItem) Then varItem = "*.*"
   AddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
   Dim intPos As Integer

   intPos = InStr(strItem, vbNullChar)
   If intPos > 0 Then
       TrimNull = Left(strItem, intPos - 1)
   Else
       TrimNull = strItem
   End If
End Function

Private Function FixPath(ByVal path As String) As String
   If Right$(path, 1) <> "\" Then
       FixPath = path & "\"
   Else
       FixPath = path
   End If
End Function
'************** Code End *****************
Chữ ký của MatTroiNguQuen Thời gian nước chảy... da mòn
Ngủ quên một chốc thấy còn bộ xương!
Reply
Những người đã cảm ơn maidinhdan , Minh Tiên , tranthanhan1962


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Tạo Form nhập liệu thông minh thanhtruong 3 320 19-05-16, 01:25 PM
Bài mới nhất: ongke0711
  [Help] Mong moi người giúp mình tạo form huymcsa 34 1,467 29-02-16, 06:32 PM
Bài mới nhất: huymcsa
  giúp mình tạo nút lệnh tìm kiếm trong form access 2003 với vân anh xinh 27 3,684 16-01-16, 10:54 PM
Bài mới nhất: ngochieu8109
  [Help] sữa tìm kiếm dùm mình banhan 2 272 30-12-15, 02:31 PM
Bài mới nhất: banhan
  [Hỏi] Giúp mình cách viết code xếp loại học sinh trong VBA NganNguyen 1 312 07-09-15, 01:39 AM
Bài mới nhất: tranthanhan1962

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ