如何绕过“选择数据源”提示查询表w / VBA

时间:2016-06-09 16:38:29

标签: sql sql-server vba excel-vba macros

我有一个宏,可以将查询数据从SQL导出到Excel中的查询表中。整个过程通过宏完成,并且已经设置了ODBC连接。由于连接已经建立,基本上我所做的只是更新宏中命令字符串中的一些数据,然后刷新它。当我在电脑上运行时,一切正常;但它被同一网络上的多个人使用。尽管与查询关联的宏最终适用于所有人,但除了我以外的所有用户都会收到“选择数据源”和“用户名/密码”提示。

有没有办法可以设置宏来执行,这样所有用户都可以在不获取这些提示的情况下运行它而无需在其计算机上设置ODBC数据源?我一直在寻找其他人能够绕过那个提示的时间(例如How to disable the "Select Data source window in VBA"),但我发现的任何东西都不适用于我。

以下是连接字符串当前为连接设置的方式:

"DSN=RTP;UID=J4;Trusted_Connection=Yes;APP=Microsoft Office 2010;WSID=123;DATABASE=C;"

以下是我的宏目前的样子:

 Sub Vols_L()

Application.ScreenUpdating = False

    Dim cn As WorkbookConnection
    Dim odbcCn As ODBCConnection, oledbCn As OLEDBConnection

    Set cn = ActiveWorkbook.Connections("Vols_L")

    Set ws = Sheets("Setup")
    Set ws6 = Sheets("L Graph")
    Set ws7 = Sheets("Queries")

    Dim Query As String
    Dim SSD As String
    Dim SED As String
    Dim PM As String
    Dim AD As String
    Dim ID As String

    Query = ws7.Range("Vols_L_Query")
    SSD = ws.Range("SSD").Value
    SED = ws.Range("SED").Value
    PM = ws.Range("FOM_PM").Value
    AD = ws.Range("AD").Value
    ID = ws.Range("ID").Value 

    Query = Replace(Query, "#SD", SSD)
    Query = Replace(Query, "#ED", SED)
    Query = Replace(Query, "#PM", PM)
    Query = Replace(Query, "#AD", AD)
    Query = Replace(Query, "#ID", ID)

    Updates the workbook Connection Depending on Type
    With cn
        If .Type = xlConnectionTypeODBC Then
            Set odbcCn = cn.ODBCConnection
            odbcCn.CommandText = Query
            odbcCn.Refresh

        ElseIf cn.Type = xlConnectionTypeOLEDB Then
            Set oledbCn = cn.OLEDBConnection
            oledbCn.CommandText = "Query"
            oledbCn.Refresh
        End If
    End With

Application.ScreenUpdating = True

End Sub
编辑:所以我遇到的一个大问题是我显然非常愚蠢。我非常感谢你的帮助,但我已经尝试了下面的回复中提到的每种方法,并且无法让它们为我工作。我尝试将UpdateWorkbookConnection查询输入到我之前粘贴的那个(它替换了注释“更新工作簿连接取决于类型”之后的所有内容),使其看起来像:

UpdateWorkbookConnection ActiveWorkbook.Connections("Vols_L"), Query, "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=C;Data Source=RTP;"

但是,当我这样做时,我在宏中的某个位置出现错误:

".OLEDBConnection.Connection = ConnectionString"

1 个答案:

答案 0 :(得分:2)

您正在使用DSN,因此,如果用户没有在其计算机上配置DSN,并且您使用的确切名称不知道该使用什么。您可以执行DSN-less连接字符串,这样您就不必去每台计算机并设置DSN。

我有时用来构建连接字符串的技巧是在桌面上创建一个文件扩展名为" .udl"的文件。双击它时,您可以选择提供程序和连接详细信息并测试连接是否有效。然后你可以打开" .udl"在记事本中输入文件并查看已构建的连接字符串。

我使用下面的VBA代码更改excel命令和/或连接字符串。它运行良好,可以防止在某些情况下有时creates a new connection when modifying a connection的错误。

Sub UpdateWorkbookConnection(WorkbookConnectionObject As WorkbookConnection, Optional ByVal CommandText As String = "", Optional ByVal ConnectionString As String = "")
'example usage
'UpdateWorkbookConnection ActiveWorkbook.Connections("Connection"), "EXEC sp_procedure"[, "optional connection string here"]

With WorkbookConnectionObject
    If .Type = xlConnectionTypeODBC Then
        If CommandText = "" Then CommandText = .ODBCConnection.CommandText
        If ConnectionString = "" Then ConnectionString = .ODBCConnection.Connection
        .ODBCConnection.Connection = Replace(.ODBCConnection.Connection, "ODBC;", "OLEDB;", 1, 1, vbTextCompare)
    ElseIf .Type = xlConnectionTypeOLEDB Then
        If CommandText = "" Then CommandText = .OLEDBConnection.CommandText
        If ConnectionString = "" Then ConnectionString = .OLEDBConnection.Connection
    Else
        MsgBox "Invalid connection object sent to UpdateWorkbookConnection function!", vbCritical, "Update Error"
        Exit Sub
    End If
    If StrComp(.OLEDBConnection.CommandText, CommandText, vbTextCompare) <> 0 Then
        .OLEDBConnection.CommandText = CommandText
    End If
    If StrComp(.OLEDBConnection.Connection, ConnectionString, vbTextCompare) <> 0 Then
        .OLEDBConnection.Connection = ConnectionString
    End If
    .Refresh
End With