Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: открытие файла Добавлено: 12.12.03 21:36  

Автор вопроса:  Нукен

В VBA есть штука Application.GetOpenFileName - вызывает диалоговое окно открытия файла. Как такую же штуку сделать в VB в своей проге?

Ответить

  Ответы Всего ответов: 5  

Номер ответа: 1
Автор ответа:
 cresta



Вопросов: 117
Ответов: 1538
 Профиль | | #1 Добавлено: 12.12.03 23:14
А что, ComDlg32.ocx нельзя  использовать?

Ответить

Номер ответа: 2
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #2
Добавлено: 14.12.03 05:03

'Это все в модуле. Если заменить везде Public на Private, можно и в форме

Const MAX_PATH=1024

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

Public Function ShowOpen(Filter As String, hwndOwner as Long, OpenDialogTitle As String) As String

On Error Resume Next

Dim OFN As OPENFILENAME

Dim sFilter As String

Dim nRes As Long

sFilter = ConvertFilter(Filter)

OFN.hInstance = App.hInstance

OFN.flags = 4

OFN.hwndOwner = hwndOwner

OFN.lpstrFile = String(MAX_PATH, vbNullChar)

OFN.lpstrTitle = OpenDialogTitle

OFN.lpstrFilter = sFilter

OFN.nMaxFile = MAX_PATH

OFN.lStructSize = LenB(OFN)

nRes = GetOpenFileName(OFN)

If nRes Then ShowOpen = Trim(OFN.lpstrFile) Else ShowOpen = ""

End Function

Private Function ConvertFilter(ByVal sFilter) As String

On Error Resume Next

Dim sTemp As String

Dim i As Integer

sTemp = sFilter

For i = 1 To Len(sTemp)

If Mid(sTemp, i, 1) = "|" Then Mid(sTemp, i, 1) = vbNullChar

Next i

ConvertFilter = sTemp

End Function

Ответить

Номер ответа: 3
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
 Профиль | | #3 Добавлено: 14.12.03 15:24

Открытие стандартного окна выбора папок/файлов

Данный пример является дополнением к "Открытие стандартного окна выбора папок/файлов", но обеспечивает дополнительную

возможность выбора только "Сетевого Окружения", а также папок ПРОГРАММЫ и ГЛАВНОЕ МЕНЮ

Вам понадобится элемент CommandButton

Private Type BrowseInfo

hWndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As Long

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Public Enum BrowseType

BrowseForFolders = &H1

BrowseForComputers = &H1000

BrowseForPrinters = &H2000

BrowseForEverything = &H4000

End Enum

Public Enum FolderType

CSIDL_BITBUCKET = 10

CSIDL_CONTROLS = 3

CSIDL_DESKTOP = 0

CSIDL_DRIVES = 17

CSIDL_FONTS = 20

CSIDL_NETHOOD = 18

CSIDL_NETWORK = 19

CSIDL_PERSONAL = 5

CSIDL_PRINTERS = 4

CSIDL_PROGRAMS = 2

CSIDL_RECENT = 8

CSIDL_SENDTO = 9

CSIDL_STARTMENU = 11

End Enum

Private Const MAX_PATH = 260

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, ListId As Long) As Long

Public Function BrowseFolders(hWndOwner As Long, sMessage As String, Browse As BrowseType, ByVal RootFolder As FolderType) As String

Dim Nullpos As Integer

Dim lpIDList As Long

Dim res As Long

Dim sPath As String

Dim BInfo As BrowseInfo

Dim RootID As Long

SHGetSpecialFolderLocation hWndOwner, RootFolder, RootID

BInfo.hWndOwner = hWndOwner

BInfo.lpszTitle = lstrcat(sMessage, "")

BInfo.ulFlags = Browse

If RootID <> 0 Then BInfo.pIDLRoot = RootID

lpIDList = SHBrowseForFolder(BInfo)

If lpIDList <> 0 Then

sPath = String(MAX_PATH, 0)

res = SHGetPathFromIDList(lpIDList, sPath)

Call CoTaskMemFree(lpIDList)

Nullpos = InStr(sPath, vbNullChar)

If Nullpos <> 0 Then

sPath = Left(sPath, Nullpos - 1)

End If

End If

BrowseFolders = sPath

End Function

Private Sub Command1_Click()

'следующие вызовы функции сработали нормально

MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_DESKTOP) '+весь компьютер

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_DRIVES) '+только устройства

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_NETHOOD) '+только сеть

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PROGRAMS) '+папка Программы

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_STARTMENU) '+Главное меню

'результат действия следующих кодов вызвал недоумение...

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_BITBUCKET) '-корзина

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_CONTROLS) '-панель управления

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_FONTS) '-папка со шрифтами

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_NETWORK) '-NetHood

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PERSONAL) '-Мои документы

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PRINTERS) '-Принтеры

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_RECENT) '-RECENT

'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_SENDTO) '-SENDTO

End Sub

Ответить

Номер ответа: 4
Автор ответа:
 Виталий51



ICQ: 224290361 

Вопросов: 8
Ответов: 50
 Web-сайт: www.feshin.info
 Профиль | | #4
Добавлено: 14.12.03 23:33

Да зачем такие нерациональные сложности? Просто воспользуйся ...-буками и оператором OPEN ... и всё!

Ответить

Номер ответа: 5
Автор ответа:
 Cooller



Вопросов: 10
Ответов: 28
 Профиль | | #5 Добавлено: 15.12.03 21:39

Нет тута Open непоможет как я понял челу надо CommonDialog программно вызвать.

Незнаю может здесь всё это уже написано, но ...

Option Compare Database

Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" _

Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function GetSaveFileName Lib "comdlg32.dll" _

Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type OPENFILENAME

lStructSize As Long

hwndOwner As Long

hInstance As Long

lpstrFilter As String

lpstrCustomFilter As Long

nMaxCustrFilter 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

lCustrData As Long

lpfnHook As Long

lpTemplateName As Long

End Type

Public Const OFN_ALLOWMULTISELECT = &H200

Public Const OFN_CREATEPROMPT = &H2000

Public Const OFN_EXPLORER = &H80000

Public Const OFN_FILEMUSTEXIST = &H1000

Public Const OFN_HIDEREADONLY = &H4

Public Const OFN_NOCHANGEDIR = &H8

Public Const OFN_NODEREFERENCELINKS = &H100000

Public Const OFN_NONETWORKBUTTON = &H20000

Public Const OFN_NOREADONLYRETURN = &H8000

Public Const OFN_NOVALIDATE = &H100

Public Const OFN_OVERWRITEPROMPT = &H2

Public Const OFN_PATHMUSTEXIST = &H800

Public Const OFN_READONLY = &H1

Public Const OFN_SHOWHELP = &H10

Public Function OpenFile(ByVal InitDir As String, ByVal fname As String) As String

Dim strFile As String * 512

Dim of As OPENFILENAME

Dim F As String

Dim p%

' Установка начальных значений структуры

of.hwndOwner = Application.hWndAccessApp

of.hInstance = 0

of.lpstrCustomFilter = 0

of.nMaxCustrFilter = 0

of.lpfnHook = 0

of.lpTemplateName = 0

of.lCustrData = 0

'Ниже вы можете изменить фильтры для поиска файлов

of.lpstrFilter = "MS Access Database (*.mdb)" & Chr$(0) & "*.mdb" & Chr$(0) & _

"Add-ins (*.mda)" & Chr$(0) & "*.mda" & Chr$(0) & _

"MDE-Files (*.mde)" & Chr$(0) & "*.mde" & Chr$(0) & _

"All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0) & Chr$(0)

of.nFilterIndex = 3

of.lpstrFile = fname & String$(512 - Len(fname), 0)

of.nMaxFile = 511

of.lpstrFileTitle = String$(512, 0)

of.nMaxFileTitle = 511

' Ниже вы можете изменить заголовок окна

of.lpstrTitle = "Открыть модуль"

of.lpstrInitialDir = InitDir

' Можете изменить расширение файла

of.lpstrDefExt = "mde"

of.Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST '+ OFN_EXPLORER

of.lStructSize = Len(of)

If GetOpenFileName(of) Then

p% = InStr(1, of.lpstrFile, Chr$(0))

OpenFile = Left(of.lpstrFile, p% - 1)

Else

OpenFile = ""

End If

End Function

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам