Control Not Licensed
Control Not Licensed
(OP)
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.





RE: Control Not Licensed
CODE
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
CODE
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
CODE
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
RE: Control Not Licensed
RE: Control Not Licensed
Do you happen to have the API code for the save dialog as well? Thanks.
RE: Control Not Licensed
CODE
CODE
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