Tùy chọn
Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
- Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
-
Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
ngochuong279 > 09-10-14, 03:31 PM
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 -
RE: Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
paulsteigel > 10-10-14, 09:27 AM
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ẻ! -
RE: Cho mình hỏi tạo FileDialog hay CommonDialog như thế nào nhỉ
MTNQ > 29-11-15, 06:06 PM
Cảm ơn bác Ngọc đã chia sẻ
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 *****************