Control Not Licensed 2

[Creigbm]

I remember reading a while back that there was an update to vba that allows a user to use CommonDialog. I cannot create this control since it is 'not properly licensed.' Any one know how to resolve this? Thanks in advance.

 

[CajunCenturion]

I'm not aware of any update to VBA to allow use of this control without the proper license, but you can accomplish the same function by calling the Windows API directly. First thing you need to do is declare the following type structure and API call.

Public Type OPENFILENAME
   tLng_StructSize            As Long
   tLng_hWndOwner             As Long
   tLng_hInstance             As Long
   tStr_Filter                As String
   tStr_CustomFilter          As String
   tLng_MaxCustFilter         As Long
   tLng_FilterIndex           As Long
   tStr_File                  As String
   tLng_MaxFile               As Long
   tStr_FileTitle             As String
   tLng_MaxFileTitle          As Long
   tStr_InitialDir            As String
   tStr_Title                 As String
   tLng_flags                 As Long
   tInt_FileOffset            As Integer
   tInt_FileExtension         As Integer
   tStr_DefExt                As String
   tLng_CustData              As Long
   tLng_Hook                  As Long
   tStr_TemplateName          As String
End Type

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

Then in a standard code module, I would add the following function which call the GetOpenFileName API which allows the user to browse for a specific set of files.

Public Function ShowOpen(rCol_FilePatterns As Collection) As String

   Dim lTyp_OpenFileName         As OPENFILENAME
   Dim lStr_FileSel              As String
   Dim lStr_FilePattern          As String
   Dim lInt_Idx                  As Integer
   Dim lStr_FileSet()            As String
   
   lStr_FilePattern = vbNullString
   For lInt_Idx = 1 To rCol_FilePatterns.Count
      lStr_FileSet = Split(rCol_FilePatterns.Item(lInt_Idx), "::")
      lStr_FilePattern = lStr_FilePattern & lStr_FileSet(0) & Chr(0) & lStr_FileSet(1) & Chr(0)
   Next lInt_Idx
   
   With lTyp_OpenFileName
      .tLng_StructSize = Len(lTyp_OpenFileName)
      .tLng_hWndOwner = 0
      .tLng_hInstance = 0
      .tStr_Filter = lStr_FilePattern
      .tStr_File = Space(254)
      .tLng_MaxFile = 255
      .tStr_FileTitle = Space(254)
      .tLng_MaxFileTitle = 255
      .tStr_InitialDir = "C:\"
      .tStr_Title = "Select SpreadSheet to Import"
      .tLng_flags = 0
   End With

   If (GetOpenFileName(lTyp_OpenFileName)) Then
      lStr_FileSel = Trim(lTyp_OpenFileName.tStr_File)
   Else
      lStr_FileSel = vbNullString
   End If

   ShowOpen = lStr_FileSel

End Function

Then inside your application, drop in code similar to the following. This examples is inside the Click event handler for a Browse function, and searches for all .xls files, and stores the selected pathname in a textbox.

Private Sub cmdBrowse_Click()

   Dim lStr_FileSelected      As String
   Dim lCol_FilePatterns      As Collection
   
   Set lCol_FilePatterns = New Collection
   lCol_FilePatterns.Add "Excel Files (*.xls)" & "::" & "*.xls"
   
   lStr_FileSelected = ShowOpen(lCol_FilePatterns)
   txtImportFile = lStr_FileSelected
   Set lCol_FilePatterns = Nothing

End Sub

 

[Creigbm]

Thank, that is exaclty what I need.

 

[Creigbm]

Cajun,

Do you happen to have the API code for the save dialog as well? Thanks.

 

[CajunCenturion]

The save code is almost identical. You need to declare the same OPENFILENAME structure listed above, but need to add the declaration for the GetSaveFileName API.

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

And the code is quite similar:

Private Sub cmdSave_Click()
    
   Dim lStr_FileSel As String
    
   lStr_FileSel = ShowSave

End Sub

Private Function ShowSave() As String
    
   Dim lStr_FileSel       As String
   Dim fTyp_SaveFileName  As OPENFILENAME
   
   With fTyp_SaveFileName
      .tLng_StructSize = Len(fTyp_SaveFileName)
      .tLng_hWndOwner = Me.hWnd
      .tLng_hInstance = App.hInstance
      .tStr_Filter = "Text Files (*.txt)" & Chr$(0) & _
                                  "*.txt" + Chr$(0) & _
                     "All Files (*.*)" + Chr$(0) & _
                                 "*.*" + Chr$(0)
      .tStr_File = Space$(254)
      .tLng_MaxFile = 255
      .tStr_FileTitle = Space$(254)
      .tLng_MaxFileTitle = 255
      .tStr_InitialDir = "C:\"
      .tStr_Title = "Select File to Save"
      .tLng_Flags = 0
   End With
    
   If (GetSaveFileName(fTyp_SaveFileName)) Then
      lStr_FileSel = Trim(fTyp_SaveFileName.tStr_File)
   Else
      lStr_FileSel = ""
   End If

   ShowSave = lStr_FileSel
    
End Function