How to use Common Dialog

[Jedi420]

I'm using Access 2000 and was wondering if someone would be so kind enough to tell me how I can reference the various dialog box's (mainly the common dialog windox) through Access 2000. Doing it the VB way (by right-clicking on the toolbox and selecting it there) is unavailable. Thank you very much.

-Jedi420

 

[nexcar]

I have a module for doing that, but its about 9 pages long. You have to make MANY calls to prevent having to use external references. By using this module, you can use it anywhere and not have to have VB on the host system. Let me know if you want it.


RUN FunnySignatureMessage

 

[nexcar]

This example is smaller that the other one but it should work. Throw this stuff into a module. Use the GetOpenFile command to open the dialogue box. You can edit the code for filters like *.txt or *.exe. It works on my system, but I have VB6 on here so you never can tell what will/won't work on someone else's system:

Option Compare Database

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

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long


Function GetOpenFile() As Variant
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant

lngFlags = ahtOFN_NOCHANGEDIR
strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT&quot
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:="Z:\RDPlans\", _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:="File Insert&quot
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
GetOpenFile = varFileName
End Function

Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String

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

Function ahtCommonFileOpenSave( _
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

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

strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)

With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If
If fResult Then
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
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

 

[Jedi420]

Thank you very much for your answer, but is there not some simple built in way to do this? All that code seems a bit much. Just curious.

-Jedi420

 

[nexcar]

Yes, there is a simpler way, but you and all your users have to have Visual Basic 6 installed. This code allows you to use cdb's without the reference files from vb6. Trust me, there is a LONGER way to do it. This was the shortest one I could come up with that didn't reference a VB6 control!

Good luck.

RUN FunnySignatureMessage

 

[hymn]

have a look at
thread705-457897

Hope this helps
Hymn

 

[nexcar]

Hymn is right. That IS a good post, but no less amount of code you'd need to accomplish this.



1100110011000110011000111100101
&HFFF

 

[Jedi420]

Thanks a bunch nexcar and hymn! I think I got things working ok now. I also found this site useful:

http://mvps.org/access/api/api0001.htm

I hope future seekers of this knowledge won't be as frustrated as I was. Thanx again! (^_^)


-Jedi420