关于VBA中自定义函数的奇怪问题 [英] Weird issue about self-defining function in VBA

问题描述

下面的VBA代码用于查询来自EXCEL数据源的数据，就像SQL

The VBA code below is for querying data from EXCEL data source,just like SQL

PUBLIC dic As Object

Function P_query(spath, sFields, swhere, Optional wsName = "Sheet1")
'If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual

  Dim rs As New ADODB.Recordset
  Dim sql$, itype$, val
  Dim arrResult
  Dim iscal As Boolean
  If iscal Then Exit Function Else iscal = True
  
  If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
  P_query = Array("")
  If Len(sFields) = 0 Or sFields = "[]" Then Exit Function
  If Dir(spath, 16) = Empty Then MsgBox "数据源路径不存在": Exit Function
  If Len(swhere) > 0 Then swhere = " where " & swhere

  If Not dic.exists(spath) Then
    Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
    With cnn
      If Application.Version = "11.0" Then
        .Provider = "microsoft.jet.oledb.4.0"
        .ConnectionString = "extended properties=""excel 8.0;HDR=YES;IMEX=1"";data source=" & spath
      Else
        .Provider = "microsoft.ACE.oledb.12.0"
        .ConnectionString = "extended properties=""excel 12.0;HDR=YES;IMEX=1"";data source=" & spath
      End If
      .Open
    End With
    dic.Add spath, cnn
  End If
  
    sql = "select " & sFields & " from [" & wsName & "$]" & swhere
    rs.CursorLocation = adUseClient
    On Error GoTo err1
    rs.Open sql, dic(spath), 1, 1
    If rs.RecordCount = 0 Then P_query = "#N/A": rs.Close: Set rs = Nothing: Exit Function
    If rs.EOF Then rs.MoveFirst
    If rs.Fields(0).Type = 5 Then itype = "Double" Else itype = "String"
    val = rs.GetRows()
    P_query = IIf(IsNull(val(0, 0)), "#N/A", Format(val(0, 0), "standard"))
    rs.Close
    Set rs = Nothing
  Exit Function
err1:
    rs.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set dic = Nothing
    Debug.Print "ERR" & "--" & Err.Description
    P_query = "#Value"
End Function

我尝试过的事情：



我在excel单元格中调用了这个函数，很奇怪!!!，有些人工作，有些则失败了。 />
我也调试了它，很奇怪!!!，它循环使它无法跳出函数，更糟糕的是，公共变量dic也无法正常工作，尽管变量 - dic包含了key-spath，代码not dic.exists（spath）出来是假的

所以，我在这里请求高手帮忙，再说一遍

What I have tried:

I had called the function in the excel cells,weird!!!,Some worked,while others failed.
And I had also debug it ,weird!!!,it circulated so that it couldn't jump out the function, what was worse,the public variable dic also couldn't work well,Although the Variable-dic contained the key-spath, the code "Not dic.exists(spath)" came out to be FALSE
So,I asked master for help here,Tks anymore

推荐答案

，itype

，val
Dim arrResult
Dim iscal As Boolean
如果 iscal 然后 退出 功能 其他 iscal = True

如果 dic Nothing 然后 设置 dic = CreateObject（ 脚本.Dictionary）
P_query = Array（ ）
如果 Len（sFields）= 0 或 sFields = [] 然后 退出 功能
如果 Dir（spath， 16 ）=空那么 MsgBox 数据源路径不存在：退出 函数
如果 Len（swhere）> 0 然后 swhere = 其中& swhere

如果 不 dic.exists（spath）然后
Dim cnn As ADODB.Connection
设置 cnn = 新 ADODB.Connection
使用 cnn
如果 Application.Version = 11.0 然后
.Provider = microsoft.jet.oledb.4.0
.ConnectionString = extended properties =excel 8.0; HDR = YES; IMEX = 1; data source =& spath
否则
.Provider = microsoft.ACE.oledb.12.0
.ConnectionString = extended properties = excel 12.0; HDR = YES; IMEX = 1; data source =& spath
结束 如果
。打开
结束
dic.Add spath，cnn
End 如果

sql = 选择& sFields& 来自[& wsName&

, val Dim arrResult Dim iscal As Boolean If iscal Then Exit Function Else iscal = True If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary") P_query = Array("") If Len(sFields) = 0 Or sFields = "[]" Then Exit Function If Dir(spath, 16) = Empty Then MsgBox "数据源路径不存在": Exit Function If Len(swhere) > 0 Then swhere = " where " & swhere If Not dic.exists(spath) Then Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection With cnn If Application.Version = "11.0" Then .Provider = "microsoft.jet.oledb.4.0" .ConnectionString = "extended properties=""excel 8.0;HDR=YES;IMEX=1"";data source=" & spath Else .Provider = "microsoft.ACE.oledb.12.0" .ConnectionString = "extended properties=""excel 12.0;HDR=YES;IMEX=1"";data source=" & spath End If .Open End With dic.Add spath, cnn End If sql = "select " & sFields & " from [" & wsName & "

& swhere
rs.CursorLocation = adUseClient
On 错误 GoTo err1
rs.Open sql，dic（spath）， 1 ， 1
如果 rs.RecordCount = 0 然后 P_query = ＃N / A：rs。关闭：< span class =code-keyword>设置 rs =无：退出 功能
如果 rs.EOF 那么 rs.MoveFirst
如果 rs.Fields（ 0 ）。Type = 5 然后 itype = Double Else itype = String
val = rs.GetRows（）
P_query = IIf（IsNull（val（ 0 ， 0 ））， ＃N / A，格式（val（ 0 ， 0 ）， standard））
rs.Close
设置 rs = 没有
退出 功能
err1：
rs 。关闭
设置 rs = 没什么
设置 cnn = 无
设置 dic = 没什么g
Debug.Print ERR& - & Err.Description
P_query = ＃Value
结束 功能

" & swhere rs.CursorLocation = adUseClient On Error GoTo err1 rs.Open sql, dic(spath), 1, 1 If rs.RecordCount = 0 Then P_query = "#N/A": rs.Close: Set rs = Nothing: Exit Function If rs.EOF Then rs.MoveFirst If rs.Fields(0).Type = 5 Then itype = "Double" Else itype = "String" val = rs.GetRows() P_query = IIf(IsNull(val(0, 0)), "#N/A", Format(val(0, 0), "standard")) rs.Close Set rs = Nothing Exit Function err1: rs.Close Set rs = Nothing Set cnn = Nothing Set dic = Nothing Debug.Print "ERR" & "--" & Err.Description P_query = "#Value" End Function

我尝试过的事情：



我在excel单元格中调用了这个函数，很奇怪!!!，有些人工作，有些则失败了。 />
我也调试了它，很奇怪!!!，它循环使它无法跳出函数，更糟糕的是，公共变量dic也无法正常工作，尽管变量 - dic包含了key-spath，代码not dic.exists（spath）出来是假的

所以，我在这里请求大师帮忙，Tks了

What I have tried:

I had called the function in the excel cells,weird!!!,Some worked,while others failed.
And I had also debug it ,weird!!!,it circulated so that it couldn't jump out the function, what was worse,the public variable dic also couldn't work well,Although the Variable-dic contained the key-spath, the code "Not dic.exists(spath)" came out to be FALSE
So,I asked master for help here,Tks anymore

这篇关于关于VBA中自定义函数的奇怪问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！