mod_browseforfolder.bas

导出Access、Sql Server数据库表到Html vb源吗

Attribute VB_Name = "Mod_BrowseForFolder"

'打开选择文件对话框
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
'-----------------------------------------------
'浏览文件夹对话框
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 Const MAX_PATH = 260
Private Const BIF_USENEWUI = &H40

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

'浏览文件夹(选择一个目录)
'参数说明:
'        lngHwnd              调用的窗口句柄
'        strPrompt            显示在对话框上的提示
'返回值:
'        成功        完整目录
'        失败        空字符串("")
'例子:
'        strDir = BrowseForFolder(Me.Hwnd,"请选择一个目录")
'
Public Function BrowseForFolder(ByVal lngHwnd As Long, _
                                ByVal strPrompt 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 = lngHwnd
      .lpszTitle = lstrcat(strPrompt, "")
      .ulFlags = BIF_USENEWUI
   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
   End If
   
   If Right$(sPath, 1) <> "\" And sPath <> "" Then
      sPath = sPath & "\"
   End If
   
   BrowseForFolder = sPath

End Function

'打开选择文件的对话框
'参数说明:
'        lngHwnd              调用的窗口句柄
'        strTitle             显示在对话框上的标题
'        strFileType          要显示的文件类型
'        strFileTypeTitle     文件类型说明
'返回值:
'        成功        文件名
'        失败        空字串("")
'例子:
'        strFileName = BrowseForFile(Me.Hwnd,"选择一个文本文件","*.Txt","文本文件")
'
Public Function BrowseForFile(ByVal lngHwnd As Long, _
                              ByVal strTitle As String, _
                              Optional ByVal strFileType As String = "", _
                              Optional ByVal strFileTypeTitle As String = "") As String
   Dim uOpenFile                    As OPENFILENAME
   Dim lReturn                      As Long
   Dim sFilter                      As String
   
   With uOpenFile
      .lStructSize = Len(uOpenFile)
      .hwndOwner = lngHwnd
      .hInstance = App.hInstance
      
      If strFileType = "" Then
         sFilter = "数据库文件(*.mdb)" & Chr(0) & "*.mdb" & Chr(0)
      Else
         sFilter = strFileTypeTitle & "(" & strFileType & ")" & Chr(0) & strFileType & Chr(0)
      End If
      
      .lpstrFilter = sFilter
      .nFilterIndex = 1
      .lpstrFile = String(257, 0)
      .nMaxFile = Len(.lpstrFile) - 1
      .lpstrFileTitle = .lpstrFile
      .nMaxFileTitle = .nMaxFile
      .lpstrInitialDir = App.Path
      .lpstrTitle = strTitle
      .flags = 0
   End With
   
   lReturn = GetOpenFileName(uOpenFile)
   
   '等于0为用户选择了"取消"
   If lReturn = 0 Then
      BrowseForFile = ""
   Else
      BrowseForFile = Trim(uOpenFile.lpstrFile)
   End If
End Function