VB、VBA、VBS的區別你搞清楚了嗎 在VB中INI文件的讀寫
用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
