如何用VBA+SQL在采购统计单中统计各个采购单数据

selen

我把所有的采购单都打开的时候 程序跑到少品牌列的那个采购单时 出现一个错误
运行时错误 ’-2147217904  至少一个参数没有被指定值
点击调试 发现这句出了问题
      Range("a" & [b65536].End(3).Row + 1).CopyFromRecordset _
       conn.Execute(strsql)
兄弟们帮忙看看！

任浪漫

selen 发表于 2019-10-11 10:57
我把所有的采购单都打开的时候 程序跑到少品牌列的那个采购单时 出现一个错误
运行时错误 ’-2147217904   ...

已经解决这个问题 采用的sql语句查询打开的采购单的字段名称有没有品牌 然后生成sql语句查询。

1. Option Explicit
   
2. Sub tj3()
   
3.     '声明变量
   
4.     Dim conn, 结果记录集, 字段名称记录集
   
5.     Dim 文件路径 As String, 文件名 As String, 订单号 As String, 项目名称 As String, 订购日期 As String, strsql As String, FieldsName As String, s As String, StrConn As String
   
6.     Dim i As Long, j As Long
   
7.     Dim Bol_PinPai As Boolean
   
8.     Dim FieldsNames()
   
9.     Application.ScreenUpdating = False '关闭屏幕刷新
   
10.     '创建后期引用对象变量
    
11.     Set conn = CreateObject("ADODB.Connection")
    
12.     Set 结果记录集 = CreateObject("ADODB.Recordset")
    
13.     Set 字段名称记录集 = CreateObject("ADODB.Recordset")
    
14.     StrConn = "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName '连接字符串
    
15.     conn.Open StrConn   '打开数据库连接
    
16.     Range("a3:l65536").ClearContents            '清除统计表历史数据
    
17.     文件路径 = ThisWorkbook.Path & ""          '获取当前工作表路径
    
18.     文件名 = Dir(文件路径 & "*.xls")            '获取当前路径下要汇总的Excel文件名
    
19.     Do While 文件名 <> ""
    
20.         If 文件名 <> ThisWorkbook.Name Then     '非本文件
    
21.             strsql = "select * from [" & 文件路径 & 文件名 & "].[order$a10:g19]"
    
22.             With 结果记录集
    
23.                 .Open strsql, conn, 1, 3
    
24.                 .movelast
    
25.                 .movefirst
    
26.                 订单号 = Mid(.Fields(0).Value, 6)
    
27.                 .movelast
    
28.                 项目名称 = Mid(.Fields(0).Value, 6)
    
29.                 .movefirst
    
30.             End With
    
31.             Debug.Print "============================================="
    
32.             strsql = "select * from [" & 文件路径 & 文件名 & "].[order$a23:i24]"
    
33.             FieldsName = ""
    
34.             With 字段名称记录集
    
35.                 .Open strsql, conn, 1, 3
    
36.                 .movelast
    
37.                 .movefirst
    
38.                 If .RecordCount = 1 Then
    
39.                     Bol_PinPai = False
    
40.                     ReDim FieldsNames(1 To .Fields.Count)
    
41.                     For i = LBound(FieldsNames) To UBound(FieldsNames)
    
42.                         FieldsNames(i) = "" '初始化字段名称数组为空
    
43.                     Next i
    
44.                     For i = 1 To .Fields.Count
    
45.                         FieldsNames(i) = .Fields(i - 1).Value   '填入字段名称到数组
    
46.                         If Not Bol_PinPai Then
    
47.                             If .Fields(i - 1).Value = "品牌" Then Bol_PinPai = True '判断有无品牌关键字
    
48.                         End If
    
49.                     Next i
    
50.                     FieldsName = IIf(Bol_PinPai, "", " 品名, '', ") '根据是否有品牌关键字 拼凑不同的查询字段表
    
51.                     For i = IIf(Bol_PinPai, 2, 3) To UBound(FieldsNames)
    
52.                         FieldsName = FieldsName & IIf(FieldsNames(i) <> "", FieldsNames(i) & ",", "'',")
    
53.                     Next i
    
54.                     FieldsName = Left(FieldsName, Len(FieldsName) - 1)  '去掉最后一位逗号
    
55.                 End If
    
56.                 .Close  '关闭对象
    
57.             End With
    
58.             s = IIf(Bol_PinPai, "有品牌", "无品牌")
    
59.             If IsNull(结果记录集.Fields(6).Value) Then  '读取日期
    
60.                 订购日期 = Mid(结果记录集.Fields(5).Value, 6)
    
61.                 Rem strsql = "select 序号,'" & 订单号 & "','" & 订购日期 & "','" & 项目名称 & "'," & FieldsName & " from [" & 文件路径 & 文件名 & "].[order$a24:i65536] where not 交货日期 is null"
    
62.             Else
    
63.                 订购日期 = Mid(结果记录集.Fields(6).Value, 6)
    
64.                 Rem strsql = "select 序号,'" & 订单号 & "','" & 订购日期 & "','" & 项目名称 & "'," & FieldsName & " from [" & 文件路径 & 文件名 & "].[order$a24:i65536] where not 交货日期 is null"
    
65.             End If
    
66.             Rem 将上面得到的字符串拼接为动态查询语句
    
67.             strsql = "select 序号,'" & 订单号 & "','" & 订购日期 & "','" & 项目名称 & "'," & FieldsName & " from [" & 文件路径 & 文件名 & "].[order$a24:i65536] where not 交货日期 is null"
    
68.             Debug.Print "【" & 文件名 & "----" & s & "】 SQL:"; strsql  '打印最终查询的sql语句到立即窗口
    
69.             Range("a" & [b65536].End(3).Row + 1).CopyFromRecordset conn.Execute(strsql) '把查询结果复制到工作表
    
70.             结果记录集.Close  '关闭对象
    
71.         End If
    
72.         文件名 = Dir()      '获取下一个文件名
    
73.     Loop
    
74.     conn.Close      '关闭对象
    
75.     Set 结果记录集 = Nothing
    
76.     Set 字段名称记录集 = Nothing
    
77.     Set conn = Nothing
    
78.     [a3] = 1
    
79.     [a3].AutoFill Range("a3:a" & [b65536].End(3).Row), xlFillSeries
    
80.     Application.ScreenUpdating = True       '开启屏幕刷新
    
81. End Sub

复制代码

cui26896

任浪漫 发表于 2019-10-11 12:23
已经解决这个问题 采用的sql语句查询打开的采购单的字段名称有没有品牌 然后生成sql语句查询。

请问一下，你的这个代码复制用的是什么软件，可以列出序号，但复制代码时不会把序号复制到，这种格式非常好，但是一直没有弄清楚方法，如愿意的话，请告诉一下。

任浪漫

cui26896 发表于 2019-10-11 12:33
请问一下，你的这个代码复制用的是什么软件，可以列出序号，但复制代码时不会把序号复制到，这种格式非常 ...

是论坛的代码块工具

提交代码块工具指示

cui26896

是百度不到去谷歌做的代码工具吗？

selen

任浪漫 发表于 2019-10-11 12:23
已经解决这个问题 采用的sql语句查询打开的采购单的字段名称有没有品牌 然后生成sql语句查询。

写的非常清晰！谢谢兄弟！！！