Dim Data$
CommonDialog1.Open
If CommonDialog1.FileName = "" Then Exit Sub
Open CommonDialog1.FileName For Input As #1
Data = Input(Lof(1),1)
Close #1
MsgBox Data

CommonDialog1.Open

CommonDialog1.Showopen

Option Explicit
' Win32 Declarations for the Common Dialog
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

' Constants for the common dialog
Private Const OFN_ALLOWMULTISELECT As Long = &H200  'Allow multi select (Open Dialog)
Private Const OFN_EXPLORER As Long = &H80000        'Set windows style explorer
Private Const OFN_FILEMUSTEXIST As Long = &H1000    'File must exist
Private Const OFN_HIDEREADONLY As Long = &H4        'Hide read-only check box (Open Dialog)
Private Const OFN_PATHMUSTEXIST As Long = &H800     'Path must exist

Private Const MAX_PATH As Long = 260 'Constant for maximum path

Public cFileName As Collection   'Filename collection
Public cFileTitle As Collection  'Filetitle collection

' Default Property Values:
Const m_def_CancelError As Long = 0
Const m_def_Filename As String = ""
Const m_def_DialogTitle As String = ""
Const m_def_InitialDir As String = ""
Const m_def_Filter As String = ""
Const m_def_FilterIndex As Long = 1
Const m_def_MultiSelect As Long = 0

' Property Variables:
Dim m_CancelError As Boolean
Dim m_Filename As String
Dim m_DialogTitle As String
Dim m_InitialDir As String
Dim m_Filter As String
Dim m_FilterIndex As Integer
Dim m_MultiSelect As Boolean

'***** CANCEL ERROR
Public Property Get CancelError() As Boolean
    CancelError = m_CancelError
End Property
Public Property Let CancelError(ByVal New_CancelError As Boolean)
    m_CancelError = New_CancelError
    PropertyChanged "CancelError"
End Property
'***** MULTI SELECT
Public Property Get MultiSelect() As Boolean
    MultiSelect = m_MultiSelect
End Property
Public Property Let MultiSelect(ByVal New_MultiSelect As Boolean)
    m_MultiSelect = New_MultiSelect
    PropertyChanged "MultiSelect"
End Property
'***** DEFAULT FILENAME
Public Property Get DefaultFilename() As String
    efaultFilename = m_Filename
End Property
Public Property Let DefaultFilename(ByVal New_Filename As String)
    m_Filename = New_Filename
    PropertyChanged "efaultFilename"
End Property
'***** DIALOG TITLE
Public Property Get DialogTitle() As String
    ialogTitle = m_DialogTitle
End Property
Public Property Let DialogTitle(ByVal New_DialogTitle As String)
    m_DialogTitle = New_DialogTitle
    PropertyChanged "ialogTitle"
End Property
'***** INITIAL DIRECTORY
Public Property Get InitialDir() As String
    InitialDir = m_InitialDir
End Property
Public Property Let InitialDir(ByVal New_InitialDir As String)
    m_InitialDir = New_InitialDir
    PropertyChanged "InitialDir"
End Property
'***** FILTER
Public Property Get Filter() As String
    Filter = m_Filter
End Property
Public Property Let Filter(ByVal New_Filter As String)
    m_Filter = New_Filter
    PropertyChanged "Filter"
End Property
'***** FILTER INDEX
Public Property Get FilterIndex() As Integer
    FilterIndex = m_FilterIndex
End Property
Public Property Let FilterIndex(ByVal New_FilterIndex As Integer)
    m_FilterIndex = New_FilterIndex
    PropertyChanged "FilterIndex"
End Property

Private Sub UserControl_Initialize()
    UserControl_Resize
End Sub
' Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_CancelError = m_def_CancelError
    m_Filename = m_def_Filename
    m_DialogTitle = m_def_DialogTitle
    m_InitialDir = m_def_InitialDir
    m_Filter = m_def_Filter
    m_FilterIndex = m_def_FilterIndex
    m_MultiSelect = m_def_MultiSelect
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_CancelError = PropBag.ReadProperty("CancelError", m_def_CancelError)
    m_Filename = PropBag.ReadProperty("efaultFilename", m_def_Filename)
    m_DialogTitle = PropBag.ReadProperty("ialogTitle", m_def_DialogTitle)
    m_InitialDir = PropBag.ReadProperty("InitialDir", m_def_InitialDir)
    m_Filter = PropBag.ReadProperty("Filter", m_def_Filter)
    m_FilterIndex = PropBag.ReadProperty("FilterIndex", m_def_FilterIndex)
    m_MultiSelect = PropBag.ReadProperty("MultiSelect", m_def_MultiSelect)
End Sub

Private Sub UserControl_Resize()
    UserControl.Height = 480
    UserControl.Width = 480
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("CancelError", m_CancelError, m_def_CancelError)
    Call PropBag.WriteProperty("efaultFilename", m_Filename, m_def_Filename)
    Call PropBag.WriteProperty("ialogTitle", m_DialogTitle, m_def_DialogTitle)
    Call PropBag.WriteProperty("InitialDir", m_InitialDir, m_def_InitialDir)
    Call PropBag.WriteProperty("Filter", m_Filter, m_def_Filter)
    Call PropBag.WriteProperty("FilterIndex", m_FilterIndex, m_def_FilterIndex)
    Call PropBag.WriteProperty("MultiSelect", m_MultiSelect, m_def_MultiSelect)
End Sub

Public Sub ShowOpen()
Call ClearECD 'Очистка списка файлов
    '** Description:
    '** Calls open dialog without OCX
    Dim epOFN As OPENFILENAME
    Dim lngRet As Long
    With epOFN
    
        If MultiSelect Then 'If Multi Select then
            .flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
            .lpstrFile = DefaultFilename & Space(9999 - Len(DefaultFilename)) & vbNullChar
            .lpstrFileTitle = Space(9999) & vbNullChar
        Else
            .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
            .lpstrFile = DefaultFilename & String(MAX_PATH - Len(DefaultFilename), 0) & vbNullChar
            .lpstrFileTitle = String(MAX_PATH, 0) & vbNullChar
        End If

        .hwndOwner = UserControl.ContainerHwnd 'Handle to window
        .lpstrFilter = SetFilter(Filter) & vbNullChar 'File filter
        .lpstrInitialDir = InitialDir & vbNullChar 'Initial directory
        .lpstrTitle = DialogTitle & vbNullChar 'Dialog title
        .lStructSize = Len(epOFN) 'Structure size in bytes
        .nFilterIndex = FilterIndex 'Filter index
        .nMaxFile = Len(.lpstrFile) 'Maximum file length
        .nMaxFileTitle = Len(.lpstrFileTitle) 'Maximum file title length
    End With
    
    lngRet = GetOpenFileName(epOFN) 'Call open dialog
    
    If lngRet <> 0 Then 'If there are no errors continue with opening file
        ParseFileName epOFN.lpstrFile
    Else
        If CancelError Then
            ' For this to work you must check in Tools\Options\General
            ' Break on Unhandled errors if it isn't already checked
            Err.Raise 32755, App.EXEName, "Cancel was selected.", "cmdlg98.chm", 32755
        End If
    End If
End Sub

' Очистка списка файлов
Public Sub ClearECD()
Set cFileName = Nothing
Set cFileTitle = Nothing
Set cFileName = New Collection
Set cFileTitle = New Collection
End Sub

Private Sub ParseFileName(sFileName As String)
    '** Description:
    '** Remove null chars from filename and parse multi filename
    '**
    '** Syntax:
    '** szFilename = ParseFileName(strFilename)
    '**
    '** Example:
    '** szFilename = ParseFileName("C:\Autoexec.bat||"
    Dim i As Long
    Dim sPath As String
    Dim sFiles() As String
    Dim Pos As Integer
    Dim sFile As String
    
    ' Create new collections
    Set cFileName = New Collection
    Set cFileTitle = New Collection
    ' Found position of two last null chars
    Pos = InStr(sFileName, vbNullChar & vbNullChar)
    ' Remove from filename last two chars
    sFile = Left(sFileName, Pos - 1)
    
    ' Check to see if filename is single or multi
    If InStr(1, sFile, vbNullChar) <> 0 Then
    ' Multi file
        sFile = Left(sFileName, Pos) & vbNullChar 'Add null char at end of filename
        sPath = Left(sFileName, InStr(1, sFileName, vbNullChar) - 1) 'Get file path
        sFiles = Split(sFile, vbNullChar) 'Split file where is nullchar
        
        ' Add all filenames to collection
        For i = LBound(sFiles) To UBound(sFiles) - 2
            ' If path doesent contain separator then add it
            If Right(sPath, 1) = "\" Then
                cFileName.Add sPath & sFiles(i)
            Else
                cFileName.Add sPath & "\" & sFiles(i)
            End If
            ' Add file title
            cFileTitle.Add sFiles(i)
            ' Remove first item from collections
            If i = 1 Then cFileName.Remove 1: cFileTitle.Remove 1
        Next
    Else ' Single file
        'Add file name to collection
        cFileName.Add sFile
        ' Add file title
        cFileTitle.Add Right(sFile, Len(sFile) - InStrRev(sFile, "\")
    End If
End Sub

Private Function SetFilter(sFlt As String) As String
    '** Description:
    '** Replace "|" with Null Character
    '**
    '** Syntax:
    '** szFilter = SetFilter(strFilter)
    '**
    '** Example:
    '** szFilter = SetFilter("Text Files (*.txt)|*.txt|All Files |*.*|"
    Dim sLen As Long
    Dim Pos As Long

    sLen = Len(sFlt) 'Get filter length
    Pos = InStr(1, sFlt, "|" 'Find first position of "|"

    ' Loop while Pos > 0
    While Pos > 0
        ' Replace "|" with null char
        sFlt = Left(sFlt, Pos - 1) & vbNullChar & Mid(sFlt, Pos + 1, sLen - Pos)
        ' Find next position of "|"
        Pos = InStr(Pos + 1, sFlt, "|"
    Wend
    SetFilter = sFlt ' Set filter
End Function