Option Explicit
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
Private Enum WhatBrowse
BIF_RETURNONLYFSDIRS = &H1
BIF_BROWSEINCLUDEFILES = &H1 Or &H4000
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
End Enum
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Dim strPathcF As String
Dim patchf As String
Dim fileSize As Long
Dim allfileSize As Long
Dim intFileCount As Integer, intCounter As Integer
Dim statbar As Long
Public Function fBrowseForFolder(hWndOwner As Long, sPrompt As String, WhatBr) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = WhatBr
End With
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
fBrowseForFolder = sPath
End Function
Public Sub copyprice() ' выбор файла "заказ.xls"
Dim A As Long
Dim sStr As String
sStr = fBrowseForFolder(hWnd, "выберите файл ""заказ.xls""", BIF_BROWSEINCLUDEFILES)
A = CopyFile(sStr, "C:\заказ.xls", False)
If A Then
MsgBox "файл скопирован"
Else
MsgBox "Ошибка.файл не скопирован"
End If
End Sub
подскажите,пожалуйсто, как в эту функцию вписать фильтр с помощью которого выбираться будет только необходимый файл или папка.