I need to use a Windows API call to invoke a Common Dialog

My API viewer isn't working so can someone post the code for invoking the Open Common Dialog box using the Windows API(I specifically do not want to use the Common Dialog control (ocx))

jmalcolmAsked:
Who is Participating?
 
VbmasterConnect With a Mentor Commented:
Here's the code. I have it declared as a class file but I have ripped out the essential parts.


Option Explicit

Private Type OPENFILENAME
  lStructSize As Long
  hWndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private m_File() As String
Private m_FileCount As Long
Private m_strDefaultExt As String
Private m_strDialogTitle As String
Private m_strFileName As String
Private m_strInitialDir As String
Private m_strFilter As String
Private m_intFilterIndex As Integer
Private m_eFlags As EnumFilFlags
Private m_intMaxFileSize As Integer

Public Enum EnumFilFlags
  FleReadOnly = &H1
  FleOverWritePrompt = &H2
  FleHideReadOnly = &H4
  FleNoChangeDir = &H8
  FleShowHelp = &H10
  FleEnableHook = &H20
  FleEnableTemplate = &H40
  FleEnableTemplateHandle = &H80
  FleNoValidate = &H100
  FleAllowMultiSelect = &H200
  FleExtensionDifferent = &H400
  FlePathMustExist = &H800
  FleFileMustExist = &H1000
  FleCreatePrompt = &H2000
  FleShareAware = &H4000
  FleNoReadOnlyReturn = &H8000
  FleNoTestFileCreate = &H10000
  FleNoNetworkButton = &H20000
  FleExplorer = &H80000
  FleLongnames = &H200000
End Enum

Private Sub GetFiles(Text As String)

  Dim a As Long
  Dim TeckenNr As Long
  Dim Dirname As String
  Dim OldTeckenNr As Long
 
  m_FileCount = 0
  TeckenNr = InStr(Text, Chr$(0))
 
  If (TeckenNr = 0) Then
    'Single file
    ReDim m_File(1)
    m_FileCount = 1
    m_File(1) = Text
  Else
    'Multiple files
    Dirname = AddDirSep(Left$(Text, TeckenNr - 1))
    OldTeckenNr = TeckenNr + 1
    TeckenNr = InStr(OldTeckenNr, Text, Chr$(0))
    Do Until (TeckenNr = 0)
      If (m_FileCount Mod 10 = 0) Then ReDim Preserve m_File(m_FileCount + 11)
      m_FileCount = m_FileCount + 1
      m_File(m_FileCount) = Dirname & Mid$(Text, OldTeckenNr, TeckenNr - OldTeckenNr)
      OldTeckenNr = TeckenNr + 1
      TeckenNr = InStr(OldTeckenNr, Text, Chr$(0))
    Loop
   
    'Add the last file
    If (OldTeckenNr <= Len(Text)) And (OldTeckenNr > 0) Then
      m_File(m_FileCount + 1) = Dirname & Mid$(Text, OldTeckenNr)
      m_FileCount = m_FileCount + 1
      ReDim Preserve m_File(m_FileCount)
    End If
   
    'Ta bort alla tomma rader
    For a = m_FileCount To 1 Step -1
      If (Len(m_File(a)) <> 0) Then Exit For
    Next
   
    If (a <> m_FileCount) Then
      m_FileCount = a
      ReDim Preserve m_File(m_FileCount)
    End If
  End If
 
End Sub

Function AddDirSep(Rad As String) As String

  AddDirSep = IIf(Right$(Rad, 1) = "\", Rad, Rad + "\")
 
End Function

Public Property Get Filename(Optional Index As Long) As String

  If (Index = 0) Then Index = 1
 
  Filename = m_File(Index)

End Property

Public Function Show(OwnerForm As Form, fOpen As Boolean, Optional DefaultExt As String, Optional DialogTitle As String, Optional Filter As String, Optional FilterIndex As Integer, Optional flags As EnumFilFlags, Optional InitialDir As String, Optional MaxFileSize As Integer) As Boolean
 
  'Returns: False if cancel selected, True otherwise.
 
  Dim of         As OPENFILENAME
  Dim strChar    As String * 1
  Dim intCounter As Integer
  Dim strTemp    As String
 
  Const cintMaxFileLength As Integer = 260

  On Local Error GoTo PROC_ERR
 
  If (Len(DefaultExt) > 0) Then m_strDefaultExt = DefaultExt
  If (Len(DialogTitle) > 0) Then m_strDialogTitle = DialogTitle
  If (Len(Filter) > 0) Then m_strFilter = Filter
  If (Len(Filter) > 0) Then m_intFilterIndex = FilterIndex
  If (flags > 0) Then m_eFlags = flags
  If (Len(InitialDir) > 0) Then m_strInitialDir = InitialDir
  If (MaxFileSize > 0) Then m_intMaxFileSize = MaxFileSize
 
  'To make Windows-style filter, replace pipes with nulls
  For intCounter = 1 To Len(m_strFilter)
    strChar = Mid$(m_strFilter, intCounter, 1)
    If strChar = "|" Then
      strTemp = strTemp & vbNullChar
    Else
      strTemp = strTemp & strChar
    End If
  Next
 
  'Initialize the OPENFILENAME type
  of.lpstrTitle = m_strDialogTitle & ""
  of.flags = m_eFlags
  of.lpstrDefExt = m_strDefaultExt & ""
  of.lStructSize = LenB(of)
  of.lpstrFilter = m_strFilter & "||"
  of.nFilterIndex = m_intFilterIndex
  of.lpstrFilter = strTemp & vbNullChar & vbNullChar
 
  'Pad file and file title buffers to maximum path length
  of.lpstrFile = m_strFileName & String$(m_intMaxFileSize - Len(m_strFileName), 0)
  of.nMaxFile = m_intMaxFileSize
  of.lpstrFileTitle = String$(cintMaxFileLength, 0)
  of.lpstrInitialDir = m_strInitialDir
  of.nMaxFileTitle = cintMaxFileLength
  of.hWndOwner = OwnerForm.hwnd
 
  'If fOpen is true, show the Open file dialog, otherwise show the Save dialog
  If fOpen Then
    Show = GetOpenFileName(of)
  Else
    Show = GetSaveFileName(of)
  End If
  If Show Then
    Call GetFiles(Left$(of.lpstrFile, InStr(of.lpstrFile, Chr$(0) + Chr$(0)) - 1))
    m_intFilterIndex = of.nFilterIndex
  End If
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "Show"
  Show = False

End Function

0
 
JuiletteCommented:
'using API open commondialogue box and read file content into text box
'
'put this in a bas module
'
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
'
Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustomFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As String
  lpstrFileTitle As String
  nMaxFileTitle As String
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
'
'
'use in an event
'
' Call the Open File dialog box and look for *.txt files
Dim filebox As OPENFILENAME  ' structure that sets the dialog box
Dim fname As String  ' will receive selected file's name
Dim retval As Long  ' return value

' Configure how the dialog box will look
filebox.lStructSize = Len(filebox)  ' the size of the structure
filebox.hwndOwner = Form1.hWnd  ' handle of the form calling the function
filebox.lpstrTitle = "Open File"  ' text displayed in the box's title bar
' The next line sets up the file types drop-box
filebox.lpstrFilter = "Text Files" & vbNullChar & "*.txt" & vbNullChar & "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
filebox.lpstrFile = Space(255)  ' initalize buffer that receives path and filename of file
filebox.nMaxFile = 255  ' length of file and pathname buffer
filebox.lpstrFileTitle = Space(255)  ' initialize buffer that receives filename of file
filebox.nMaxFileTitle = 255  ' length of filename buffer
' Allow only existing files and hide the read-only check box
filebox.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY

' Execute the dialog box
retval = GetOpenFileName(filebox)
If retval <> 0 Then  ' if the dialog box completed successfully
  ' Remove null space from the file name
  fname = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
  Dim filenum As Integer
  filenum = FreeFile
  Dim strFile As String
'read the file in question and output it's content to text1 textbox
Open fname For Input As #1
Text1.Text = Input(LOF(1), 1)
Close #1
 
  End If
0
All Courses

From novice to tech pro — start learning today.