用VB实现目录选择+浏览
2007-07-05 10:43:10| 分类:
VB和VBA知识
| 标签:
|举报
|字号大中小 订阅
用VB实现目录选择+浏览(调用API)
'下面调用API实现浏览、选择目录(不能新建目录)
'Common.bas************************************************************
*
Option Explicit
Public 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 Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal
lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As
BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal
pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String)
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 = BIF_RETURNONLYFSDIRS
End With
'调用API
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
BrowseForFolder = sPath
End Function
'**********************************************************************
****
下面在窗体中的按钮中调用
Private Sub cmdBrowse_Click()
Dim strResFolder As String
strResFolder = BrowseForFolder(hWnd, "请选择一个目录.")
If strResFolder = "" Then
Call MsgBox("你取消了选择目录..", vbExclamation)
Else
Call MsgBox("目录" & strResFolder & "被选择!", vbExclamation)
End If
End Sub
我自己的VB程序 加载commondialog 对象
Private Sub Command4_Click()
With CommonDialog1
.InitDir = App.Path
.Filter = "Excel Files(*.XLS)"
.FileName = ""
.ShowOpen
End With
End Sub
VB中使用excel
Public mysum, mycity, myregion, mygroup, myshop, mypromotion As Long
Private Sub Form_Load()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Private Sub Command1_Click()
Command1.Enabled = False
Label2.Caption = Time
Label7.Caption = CommonDialog1.FileName
a = Label7.Caption
'Workbooks.Open FileName:=a
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(a)
xlApp.Visible = True
xlApp.DisplayAlerts = True
'xlApp.Visible = False
'xlApp.DisplayAlerts = False
Set xlSheet = xlBook.Worksheets("national")
xlSheet.Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="d:\City.xls"
'*****************中间过程开始
'******************中间过程结束
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="d:\City.xls"
Workbooks.Close
Set xlApp = CreateObject("Excel.Application")
xlApp.Quit
Set xlApp = Nothing '释放EXCEL对象
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Label4.Caption = Time
Command1.Enabled = True
MsgBox ("结束了")
End Sub
评论这张
转发至微博
转发至微博
评论