求助用 VB6 封装包含 SQL 语句的VBA 的问题

soleilzx · 发表于 2018-7-27 22:50

本帖最后由 soleilzx 于 2018-7-28 23:37 编辑

大家好，先介绍一下背景，由于公司安全要求，在公司的计算机系统上禁止个人用户注册，安装 .dll文件，但不禁止VBA。所以我想把自己的代码在私人电脑上用VB6封装成 .exe 文件，然后在公司电脑上共享给同事使用，

公司工作环境是 Win7 和 Excel 2013
我私人电脑环境是 Win8.1 和 Excel 2016

我现在碰到的问题是，在VBE中运行正常，可以确认代码没问题，但在封装过程中总是在 “sdb.Open cnn” 运行不过去
所以请求各位 Excel 行家帮助找一下以下封装代码的问题到底出在哪里。

Sub Main()
Dim sPath As String
Dim ExcelApp As Excel.Application ' ================================ 定义ExcelApp 为 Excel对象
Dim bCreatApp As Boolean
Dim wWB As Workbook
sPath = App.Path & "" ' ====================================== 获得当前Exe文件所在文件夹
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application") ' 获取已经打开的 Excel 程序
bCreatApp = ExcelApp Is Nothing
On Error GoTo 0
If bCreatApp Then ' ========================================= 如果 Excel 程序未打开
Set ExcelApp = CreateObject("Excel.Application") ' ====== ================ 则打开 Excel 程序
ExcelApp.Visible = True ' ====================================== 显示 Excel 程序
With ExcelApp
Set wWB = .Workbooks.Open(sPath & "TEST-Encapsulation V1.xlsm") ' ========== 打开目标 Excel 文件
End With
Else
With ExcelApp
For Each wkb In .Workbooks
If wkb.Name = "TEST-Encapsulation V1.xlsm" Then ' ===================== 找到目标文件
Set wWB = .Workbooks("TEST-Encapsulation V1.xlsm") ' ================== 把目标文件赋给 wWB
End If
Next
End With
End If
' ====================== 以下代码开始计算聚合表 =========================
With wWB
Set sdb = CreateObject("adodb.connection")
cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" _
& .FullName ' ====================== SQL 链接语句
qry = "transform count(*) select `Dept` from [TestDB$] group by `Dept` pivot `OS Class`"
sdb.Open cnn ' ============================= 链接数据源表
Set sta = sdb.Execute(qry) ' =============== 执行数据SQL语句
With .Worksheets("Statistic") ' ============ 在统计工作表中，显示SQL语句执行结果
For i = 0 To sta.Fields.Count - 1
.Cells(1, i + 1) = sta.Fields(i).Name
Next i
.Cells(2, 1).CopyFromRecordset sta
End With
sdb.Close
Set sdb = Nothing
End With
End Sub

复制代码

microyip · 发表于 2018-7-28 07:53

其他暂时没看出什么问题，但有一个地方可能需要考虑一下调整

soleilzx · 发表于 2018-7-28 23:12

本帖最后由 soleilzx 于 2018-7-28 23:40 编辑

microyip 发表于 2018-7-28 07:53
其他暂时没看出什么问题，但有一个地方可能需要考虑一下调整

谢谢 microyip 的回复，依您的提示我分别在 24，27 和 29 行添加了退出语句，如下代码段：
但是在代码的封装过程中，仍然被卡在第41行的对数据源的链接语句上，并且提示 “未找到提供程序”，如下图
所以我想继续追问，我的代码是在哪里出了问题，能否烦您继续指点迷津？

C:\Users\soleil\Desktop\Appendre\04 Excel\04 Encapsulation VBA\捕获.PNG

Sub Main()
Dim sPath As String
Dim ExcelApp As Excel.Application ' 定义ExcelApp 为 Excel对象
Dim bCreatApp As Boolean
Dim wWB As Workbook
sPath = App.Path & "" ' 获得当前Exe文件所在文件夹
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application") ' 获取已经打开的 Excel 程序
bCreatApp = ExcelApp Is Nothing
On Error GoTo 0
If bCreatApp Then ' ========================================= 如果 Excel 程序未打开
Set ExcelApp = CreateObject("Excel.Application") ' ====== 则打开 Excel 程序
ExcelApp.Visible = True ' =============================== 显示 Excel 程序
With ExcelApp
Set wWB = .Workbooks.Open(sPath & "TEST-Encapsulation V1.xlsm") ' ======= 打开目标 Excel 文件
End With
Else
With ExcelApp
For Each wkb In .Workbooks
If wkb.Name = "TEST-Encapsulation V1.xlsm" Then ' =========== 找到目标文件
Set wWB = .Workbooks("TEST-Encapsulation V1.xlsm") ' ==== 把目标文件赋给 wWB
GoTo jump:
End If
Next
Exit Sub
End With
jump:
End If
' ====================== 以下代码开始计算聚合表 =========================
With wWB
Set sdb = CreateObject("adodb.connection")
cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" _
& .FullName ' ====================== SQL 链接语句
qry = "transform count(*) select `Dept` from [TestDB$] group by `Dept` pivot `OS Class`"
sdb.Open cnn ' ============================= 链接数据源表
Set sta = sdb.Execute(qry) ' =============== 执行数据SQL语句
With .Worksheets("Statistic") ' ============ 在统计工作表中，显示SQL语句执行结果
For i = 0 To sta.Fields.Count - 1
.Cells(1, i + 1) = sta.Fields(i).Name
Next i
.Cells(2, 1).CopyFromRecordset sta
End With
sdb.Close
Set sdb = Nothing
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 求助用 VB6 封装包含 SQL 语句的VBA 的问题