Excel工作表（用户选择保存文件名与路径）.docVIP

Dim myYN As Integer Public strSQL As String, gxpath As String Public Cn As Object Public Rs As Object 功能：桌面路径 Private Declare Function SHGetFolderPath Lib shfolder.dll Alias SHGetFolderPathA (ByVal hwndOwner As Long, _ ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As String) As Long Private Declare Function GetDesktopWindow Lib user32 () As Long Private Const CSIDL_DESKTOP = H0 Private Const SHGFP_TYPE_CURRENT = H0 Public Function GetMyFolderPath() As String Dim sBuf As String sBuf = Space$(255) SHGetFolderPath GetDesktopWindow, CSIDL_DESKTOP, 0, SHGFP_TYPE_CURRENT, sBuf sBuf = Trim$(sBuf) GetMyFolderPath = Left$(sBuf, Len(sBuf) - 1) End Function 功能：桌面路径 Public Sub myCS() 连接Access数据库 Dim strPTR As String On Error GoTo ErrorHandler Set Cn = CreateObject(ADODB.Connection) Set Rs = CreateObject(ADODB.Recordset) strPTR = Provider=Microsoft.Jet.OLEDB.4.0;Data Source= gxpath Cn.Open strPTR Exit Sub ErrorHandler: MsgBox Err.Description, , Err.Number End End Sub Public Sub KillExcel() 杀EXCEL进程 Dim objSet Dim ITEM Set objSet = GetObject(winmgmts:).InstancesOf(Win32_Process) For Each ITEM In objSet If LCase(ITEM.Name) = excel.exe Then Shell taskkill /f /im excel.exe End If Next End Sub Private Sub Command1_Click() Dim myFifeName As String myYN = 0 设置“取消”为 True CommonDialog1.CancelError = True On Error GoTo ErrHandler 显示另存为对话框 With CommonDialog1 .InitDir = GetMyFolderPath 默认路径 .FileName = 工作表 默认文件名 .Filter = EXECL 文件 (*.XLS)|*.xls 文件类型 .ShowSave ‘让用户选择保存路径、文件名 判断是否选择文件 If CommonDialog1.FileName = Then Exit Sub myFifeName = .FileName End With myYN = 1 If Dir(myFifeName) Then Kill myFifeName 删除已存在的文件 End If Dim xlApp As Excel.Application 定义EXCEL类 Dim xlBook As Excel.Workbook 定义工件簿类 Dim xlsheet As Excel.Worksheet 定义工作表类 建立Excel新实例 Set xlsApp = CreateObject(Excel.Applica