Execute SQL Stored Proc Via Access VBA

时间:2017-06-19 14:01:20

标签: sql-server ms-access access-vba

I have been attempting to run an executable SQL Stored Procedure from MS Access and am having a little trouble getting Access VBA to run it correctly. Any advice would be much appreciated.

The data is being gathered from a Form which I believe I have managed to link to the required Dim's but I cannot get the connection to work.

SQL Stored Procedure Execution;

EXEC staff.usp_AddNewStaffMember
              @Brand = 'BRAND'
            , @StaffPrefName = 'NAME'
            , @NTLoginID = 'PC LOGIN'
            , @NMCUsername = 'NMC LOGIN'
            , @StaffAuditLevel = 1
            , @EmailAddress = 'EMAIL@Email.com'
            , @PhoneLogin = '0000'
            , @TeamName = 'TEAM NAME'
            , @TeamSegment = 'TEAM SEGMENT'
            , @StartDate = '2017-06-20'
            , @JobTitle = 'JOB TITLE'

VBA Code in Access;

Function AddStaff()

Dim adoCN               As New ADODB.Connection
Dim sConnString         As String

Dim cmdObjCMD As New ADODB.Command

Dim StaffNameDataTxt
Dim NTloginIDDataTxt
Dim NMCUsernameDataTxt
Dim StaffAuditLevelDataTxt
Dim EmailAddressDataTxt
Dim PhoneLoginDataTxt
Dim TeamNameDataTxt
Dim TeamSegmentDataTxt
Dim StartDateDataTxt
Dim JobTitleDataTxt

DoCmd.OpenForm "AddNewStaff"

Forms!AddNewStaff.TboxStaffName.Value = StaffNameDataTxt
Forms!AddNewStaff.TBoxPCLoginID.Value = NTloginIDDataTxt
Forms!AddNewStaff.TBoxNMCUsername.Value = NMCUsernameDataTxt
Forms!AddNewStaff.TBoxStaffAuditLevel.Value = StaffAuditLevelDataTxt
Forms!AddNewStaff.TBoxEmailAddress.Value = EmailAddressDataTxt
Forms!AddNewStaff.TBoxPhoneLogin.Value = PhoneLoginDataTxt
Forms!AddNewStaff.TBoxTeamName.Value = TeamNameDataTxt
Forms!AddNewStaff.TBoxTeamSegment.Value = TeamSegmentDataTxt
Forms!AddNewStaff.TBoxStartDate.Value = StartDateDataTxt
Forms!AddNewStaff.TBoxJobTitle.Value = JobTitleDataTxt

Set adoCN = New ADODB.Connection

sConnString = "Provider           =   SQLOLEDB;     " & _
              "Data Source        =   KCOMSQL26;    " & _
              "Initial Catalog    =   EclipseDW;    " & _
              "User ID            =   EclipseDW;    " & _
              "Password           =   ***********;  " & _
              "Trusted_Connection =   Yes;          "

adoCN.Open sConnString

sConnString.QueryDefs("EXEC staff.usp_AddNewStaffMember" & _
                 "  @Brand = 'BRAND'" & _
                 ", @StaffPrefName = StaffNameDataTxt" & _
                 ", @NTLoginID = NTloginIDDataTxt" & _
                 ", @NMCUsername = NMCUsernameDataTxt" & _
                 ", @StaffAuditLevel = StaffAuditLevelDataTxt" & _
                 ", @EmailAddress = EmailAddressDataTxt" & _
                 ", @PhoneLogin = PhoneLoginDataTxt" & _
                 ", @TeamName = TeamNameDataTxt" & _
                 ", @TeamSegment = TeamSegmentDataTxt" & _
                 ", @StartDate = StartDateDataTxt" & _
                 ", @JobTitle = JobTitleDataTxt").Execute

Set sConnString = Nothing
Set cmdObjCMD = Nothing

End Function

1 个答案:

答案 0 :(得分:0)

是的,这与一段时间内的内容重复。

我将分享我的方法。一旦运行,它就可以重复使用,并且对程序员来说是“可读的”。

创建单独的模块以将“链接”存储到SQL服务器。

定义常量(例如):

Public Const ODBC_ADO = _
"Provider=SQLOLEDB; " & _
"Data Source=servername;" & _
"Database=MyDatabase;" & _
"Trusted_Connection=yes;" 'etc. ... '

然后我为每个SQL存储过程创建Public Sub:

Public Sub SQL_task(*** all your incomming parameters here ***)
        Dim cmd As New ADODB.Command
        Dim rs As New ADODB.Recordset
        Dim str As String

        With cmd
            .ActiveConnection = ODBC_ADO   ' your connection string '
            .CommandTimeout = 10           ' SQL timeout in seconds (by default it is 60, you can turn it down)'
            .CommandType = adCmdStoredProc ' type of your query to the SQL server'
            .NamedParameters = True  ' set named parameters to true, because it is annoying to send parameters in the right sequence and troubleshoot it...'
            .CommandText = "[staff].[usp_AddNewStaffMember]"   ' name of your stored procedure'            
            .Parameters.Append .CreateParameter("@Brand", adVarWChar, adParamInput, 1024, "* new Brand *")
            If (Not (IsNull(OptionalVariable))) Or (OptionalVariable<> 0) Then 
                .Parameters.Append .CreateParameter("@OptionalVariable", adInteger, adParamInput, , CLng(OptionalVariable))  
                End if
            .Parameters.Append .CreateParameter("@Response", adBSTR, adParamOutput, 2000)       
            Set rs = .Execute
            .ActiveConnection.Close
            End With
        If Not IsNull(cmd.Parameters("@Response")) Then MsgBox (LTrim(RTrim(CStr(cmd.Parameters("@Response")))))
        Exit Sub
        '--------'
        ErrorExit:
        If Err.Number <> 0 Then MsgBox "Error Number: " & Err.Number _
                    & vbNewLine & "Description: " & Err.description
        'Resume Next

End Sub
  • @Brand - 是你的参数的开头,
  • @OptionalVariable - 处理可选参数很棘手,但这可能会对您有所帮助
  • @Response - 输出参数 - 知道如何从SQL服务器获取单行响应非常好。如果有SQL端验证,我会使用错误消息。

在我的SQL存储过程中,有类似的东西:

SET @Response = N'Something is wrong with your data...'

一些帮助您生成所需参数的链接: