I have a txt file on my local PC, this has to be check and then line by line uploaded into SQL Server 2016 using a Stored Procedure from MS Access using ADODB. It looks like Access is running always 2 rows fast and then making a short stop.
In MS Access I'm using this function:
Public Function ImportData(FileString As String)
Dim WholeLine As String
Dim cc As Variant
Dim sapPurchaseDocument As String
Dim sapPartNumber As String
Dim sapPartName As String
Dim sapDocumentDate As String
Dim sapSupplier As String
Dim sapPlant As String
Dim sapSLoc As String
Dim sapQuantity As Double
Dim sapUOM As String
Dim sapTargetQuantity As Double
Dim sapDeliveryDate As String
Dim sapPrevQuantity As Double
Dim sapReceivedQuantity As Double
Dim sapIssuedQuantity As Double
Dim sapDeliveredQuantity As Double
Dim sapPurchaseRequisition As String
Dim sapPurchaseRequisitionItem As String
Dim sapCreationIndicatior As String
Dim sapNoOfPositions As Double
Dim totalCount As Integer
Dim sapPurchaseDocumentItem As String
Dim rs As New ADODB.Recordset
Call GetConnection
Set rs.ActiveConnection = myCN
If Right(FileString, 3) = "txt" Then
totalCount = GetRowCount(FileString)
Open FileString For Input As #1
i = 0
Do While Not EOF(1)
Line Input #1, WholeLine
If Left(WholeLine, 3) = "| 4" Then
'Debug.Print WholeLine
cc = Split(WholeLine, "|")
sapPurchaseDocument = Trim(cc(1))
sapPartNumber = Trim(Replace(cc(2), ".", ""))
sapPartName = Trim(Replace(cc(3), "'", ""))
sapDocumentDate = Right(cc(4), 4) & "-" & Mid(cc(4), 4, 2) & "-" & Left(cc(4), 2)
sapSupplier = cc(5)
sapPlant = cc(6)
sapSLoc = cc(7)
sapQuantity = Replace(cc(8), ",", "")
sapUOM = Trim(cc(9))
sapTargetQuantity = Replace(cc(10), ",", "")
sapDeliveryDate = Right(cc(11), 4) & "-" & Mid(cc(11), 4, 2) & "-" & Left(cc(11), 2)
sapPrevQuantity = cc(12)
sapReceivedQuantity = Replace(cc(13), ",", "")
sapIssuedQuantity = Replace(cc(14), ",", "")
sapDeliveredQuantity = Replace(cc(15), ",", "")
sapPurchaseRequisition = Trim(cc(16))
sapPurchaseRequisitionItem = Trim(cc(17))
sapCreationIndicatior = cc(18)
sapNoOfPositions = cc(19)
sapPurchaseDocumentItem = Trim(cc(20))
strSQL = "spInsertUpdateSAPME2M '" & sapPurchaseDocument & "', '" & sapPartNumber & "', '" & sapPartName & "', '" & _
sapDocumentDate & "', '" & sapSupplier & "', '" & sapPlant & "', '" & sapSLoc & "', " & _
sapQuantity & ", '" & sapUOM & "', " & sapTargetQuantity & ", '" & sapDeliveryDate & "', " & _
sapPrevQuantity & ", " & sapReceivedQuantity & ", " & sapIssuedQuantity & ", " & _
sapDeliveredQuantity & ", '" & sapPurchaseRequisition & "', '" & sapPurchaseRequisitionItem & "', '" & _
sapCreationIndicatior & "', '" & sapNoOfPositions & "', '" & sapPurchaseDocumentItem & "'"
rs.Open (strSQL)
DoEvents
End If
i = i + 1
Debug.Print i
Forms!frm_Overview.lblStatus.Caption = "Record " & i & " of " & totalCount & " loaded. Please wait!"
DoEvents
'Refresh
Loop
MsgBox "Import done"
End If
Close #1
End Function
And on SQL Server I have a stored procedure which looks like this:
USE [MOBILEPRINT]
GO
/****** Object: StoredProcedure [dbo].[spInsertUpdateSAPME2M] Script Date: 5/25/2020 11:39:31 AM ******/
SET ANSI_NULLS OFF
GO
SET QUOTED_IDENTIFIER ON
GO
CHANGE NO ACTION
ALTER PROCEDURE [dbo].[spInsertUpdateSAPME2M]
-- Add the parameters for the stored procedure here
#sapPurchaseDocument varchar(50),
#sapPartNumber varchar(50),
#sapPartName varchar(300),
#sapDocumentDate date,
#sapSupplier varchar(50),
#sapPlant varchar(100),
#sapSLoc varchar(50),
#sapQuantity float,
#sapUOM varchar(50),
#sapTargetQuantity float,
#sapDeliveryDate date,
#sapPrevQuantity float,
#sapReceivedQuantity float,
#sapIssuedQuantity float,
#sapDeliveredQuantity float,
#sapPurchaseRequisition varchar(50),
#sapPurchaseRequisitionItem varchar(50),
#sapCreationIndicatior varchar(50),
#sapNoOfPositions varchar(50),
#sapPurchaseDocumentItem varchar(50)
AS
BEGIN TRANSACTION
-- SET NOCOUNT ON added to prevent extra result sets from
-- interfering with SELECT statements.
SET NOCOUNT ON;
DECLARE #RESULT int
DECLARE #UPDATE_CHECK int
DECLARE #UpdateDate datetime = GetDate()
BEGIN
SELECT #RESULT = COUNT(sapPurchaseDocument) FROM SAP_ME2M WHERE sapPurchaseDocument = #sapPurchaseDocument AND sapPartNumber = #sapPartNumber
IF ISNULL(#RESULT,0) = 0
BEGIN
INSERT INTO SAP_ME2M (
sapPurchaseDocument,
sapPartNumber,
sapPartName,
sapDocumentDate,
sapSupplier,
sapPlant,
sapSLoc,
sapQuantity,
sapUOM,
sapTargetQuantity,
sapDeliveryDate,
sapPrevQuantity,
sapReceivedQuantity,
sapIssuedQuantity,
sapDeliveredQuantity,
sapPurchaseRequisition,
sapPurchaseRequisitionItem,
sapCreationIndicatior,
sapNoOfPositions,
ChangeDate,
sapPurchaseDocumentItem)
VALUES
(#sapPurchaseDocument, #sapPartNumber, #sapPartName, #sapDocumentDate, #sapSupplier, #sapPlant,
#sapSLoc, #sapQuantity, #sapUOM, #sapTargetQuantity, #sapDeliveryDate, #sapPrevQuantity,
#sapReceivedQuantity, #sapIssuedQuantity, #sapDeliveredQuantity, #sapPurchaseRequisition,
#sapPurchaseRequisitionItem, #sapCreationIndicatior, #sapNoOfPositions, #UpdateDate, #sapPurchaseDocumentItem)
END
ELSE
SELECT #UPDATE_CHECK = COUNT(*) FROM SAP_ME2M WHERE
sapPurchaseDocument = #sapPurchaseDocument AND
sapPartNumber = #sapPartNumber AND
sapPartName = #sapPartName AND
sapDocumentDate = #sapDocumentDate AND
sapSupplier = #sapSupplier AND
sapPlant = #sapPlant AND
sapSLoc = #sapSLoc AND
sapQuantity = #sapQuantity AND
sapUOM = #sapUOM AND
sapTargetQuantity = #sapTargetQuantity AND
sapDeliveryDate = #sapDeliveryDate AND
sapPrevQuantity = #sapPrevQuantity AND
sapReceivedQuantity = #sapReceivedQuantity AND
sapIssuedQuantity = #sapIssuedQuantity AND
sapDeliveredQuantity = #sapDeliveredQuantity AND
sapPurchaseRequisition = #sapPurchaseRequisition AND
sapPurchaseRequisitionItem = #sapPurchaseRequisitionItem AND
sapCreationIndicatior = #sapCreationIndicatior AND
sapNoOfPositions = #sapNoOfPositions AND
sapPurchaseDocumentItem = #sapPurchaseDocumentItem
IF #UPDATE_CHECK = 0
BEGIN
UPDATE SAP_ME2M SET
sapPartName = #sapPartName ,
sapDocumentDate = #sapDocumentDate ,
sapSupplier = #sapSupplier ,
sapPlant = #sapPlant ,
sapSLoc = #sapSLoc ,
sapQuantity = #sapQuantity ,
sapUOM = #sapUOM ,
sapTargetQuantity = #sapTargetQuantity ,
sapDeliveryDate = #sapDeliveryDate ,
sapPrevQuantity = #sapPrevQuantity ,
sapReceivedQuantity = #sapReceivedQuantity ,
sapIssuedQuantity = #sapIssuedQuantity ,
sapDeliveredQuantity = #sapDeliveredQuantity ,
ChangeDate = #UpdateDate
WHERE
sapPartNumber = #sapPartNumber AND
sapPartName = #sapPartName AND
sapDocumentDate = #sapDocumentDate AND
sapSupplier = #sapSupplier AND
sapPlant = #sapPlant AND
sapSLoc = #sapSLoc AND
sapPurchaseDocumentItem = #sapPurchaseDocumentItem
END
END
COMMIT TRANSACTION WITH (DELAYED_DURABILITY = ON);
I have to upload around 30000 Records which takes more then an hour at the moment.
If you have suggestions, please let me know.
For fast data transfer, use a disconnected recordset with batch operations enabled.
Dim conn As ADODB.Connection
Call GetConnection
Set conn = myCN
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "Table1", conn, adOpenForwardOnly, adLockBatchOptimistic
'Disconnect
Set rs.ActiveConnection = Nothing
Dim i As Long
For i = 1 To 3000
rs.AddNew
rs.Fields(1) = i
Next
'Reconnect
Set rs.ActiveConnection = conn
'Batch insert
rs.UpdateBatch
Debug.Print Now()
For me, this executes in 2 seconds, but it highly depends on the location of SQL server.
Then, process further on the data set when uploaded. Processing on a per-record basis is usually going to be slow.
Related
I get data from SQL Server and now I want to copy it in Excel worksheet.
I tried to format "start_date" but it applied the format only on the first column, all others display as stored in SQL Server.
Sub ReadMBDataFromSQL()
Dim Server_Name, Database_Name, User_ID, Password, SQLStr As String
Set Cn = CreateObject("ADODB.Connection")
Set RS = New ADODB.Recordset
Server_Name = ""
Database_Name = ""
User_ID = ""
Password = ""
SQLStr = "SELECT lot, po, start_date, input_sponge_type, input_sponge_type FROM PalladiumNitrateMB WHERE start_date >= '" & Format(Range("start"), "mm-dd-yyyy") & "' AND start_date < '" & Format(Range("end"), "mm-dd-yyyy") & "' ORDER BY lot ASC"
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
RS.Open SQLStr, Cn, adOpenKeyset, adLockBatchOptimistic
With Worksheets("PdNitrateMassBalance").Range("A5:N600")
RS("start_date") = Format(RS("start_date"), "dd/mm/yyyy")
.ClearContents
.CopyFromRecordset RS
End With
RS.Close
Set RS = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Try replacing this part
With Worksheets("PdNitrateMassBalance").Range("A5:N600")
RS("start_date") = Format(RS("start_date"), "dd/mm/yyyy")
.ClearContents
.CopyFromRecordset RS
End With
With this
With Worksheets("PdNitrateMassBalance")
With .Range("A5:N600")
.ClearContents
.CopyFromRecordset RS
End With
FixDatesFromYYYY_MM_DD .Range("A:A"), "dd/mm/yyyy"
End With
And additional sub:
Sub FixDatesFromYYYY_MM_DD(DatesRange As Range, Format As String)
Dim r As Range
Dim firstDash As Integer, secondDash As Integer, i As Integer
For Each r In DatesRange
If Not r.Value = "" Then
firstDash = 0
secondDash = 0
For i = 1 To Len(r.Text)
If Mid(r.Text, i, 1) = "-" Then
If Not firstDash = 0 Then
secondDash = i
Exit For
Else
firstDash = i
End If
End If
Next
With r
.Value = DateSerial(Left(r.Text, 4), Mid(r.Text, firstDash + 1, IIf(secondDash = 7, 1, 2)), Mid(r.Text, secondDash + 1))
.NumberFormat = Format
End With
End If
Next
End Sub
Update
Added a sub to convert dates from "yyyy-mm-dd" text format.
Problem solved by modifying of the SQL query, i request the date with
convert(varchar,start_date,103)
I have an issue with a project I am working on and updating a string within an array when a loop is initiated.
To provide a little context, the code is to amend errors that user's may have made when entering information and to update all the related tables in the one go.
Option Compare Database
Dim Var1 As Variant, SQL_select As Variant, SQL_update As Variant, newVar1 As String
Dim j As Integer, rsField As Variant, n As Variant
Public Sub amendCust_control()
Dim db As Database, rs As Recordset, cntRec As Integer, i As Integer, SQL_s As String, SQL_u As String
For j = 0 To 3
Var1 = Forms!mm_amendcustomer_temp!Var1
newVar1 = Forms!mm_amendcustomer_temp!Text50
assSelArray
SQL_s = SQL_select(j)
Set db = CurrentDb
Set rs = db.OpenRecordset(SQL_s)
If rs.EOF Then
cntRec = 0
Else
rs.MoveLast
cntRec = rs.RecordCount
End If
If cntRec > 0 Then
ReDim n(0 To (cntRec - 1))
rs.MoveFirst
For i = 0 To (cntRec - 1)
n(i) = rs.Fields(rsField(j))
assignSQLuparray 'populates update field with current value of n(j)
SQL_u = SQL_update(j)
Set SQL_update = Nothing
rs.MoveNext
Next i
Else
Exit Sub
End If
Set rs = Nothing
Set db = Nothing
Next j
Set rs = Nothing
Set db = Nothing
End Sub
I have then split my three string arrays between 2 subs, as below.
Private Sub assSelArray()
SQL_select = Array(("SELECT [Var1] FROM [Customer] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [transNo] FROM [Transactions] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [VAR_O] FROM [Overpayment] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [Access ID] FROM [Audit History] WHERE [Var1] = '" & Var1 & "'"))
rsField = Array("Var1", "transNo", "VAR_O", "[Access ID]")
End Sub
This is the array I am having difficulty with as the values of n(i) do not update on each iteration on the code, i.e. when n(i) changes value in the main sub, it does not do so in the array.
Private Sub assignSQLuparray()
SQL_update = Array(("UPDATE [Customer] SET Var1 = '" & newVar1 & "' WHERE Var1 = '" & n(i) & "'"), _
("UPDATE [Transactions] SET Var1 = '" & newVar1 & "' WHERE transNo = '" & n(i) & "'"), _
("UPDATE [Overpayment] SET Var1 = '" & newVar1 & "' WHERE VAR_O = '" & n(i) & "'"), _
("UPDATE [Audit History] SET Var1 = '" & newVar1 & "' WHERE [Access ID] = '" & n(i) & "'"))
End Sub
I had hoped someone may be able to help me to essentially 'refresh' the array values before calling them. Help?
The output was as below:
n(0) = 5
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(1) = 6
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(2) = 7
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(3) = 8
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(4) = 11
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
Notice the Access ID does not change as it should to n(0 to 4).
hi i would like to ask for your Help i have an MSACCESS code and i want to convert it to SQL (SSMS) please see code below.
Private Sub updateDuplicateNetwork()
Dim rstTemp As DAO.Recordset
Dim rst As DAO.Recordset
Dim strPIN As String
Dim strContract As String
Dim strNetwork As String
Set rstTemp = CurrentDb.OpenRecordset("qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue")
Set rst = CurrentDb.OpenRecordset("tbl_HR_Contract_Detail")
If Not rstTemp.EOF Then
rstTemp.MoveFirst
Do While Not rstTemp.EOF
If rstTemp!strNetwork <> strNetwork Or rstTemp!strNetwork <> strNetwork Or rstTemp!strNetwork <> strNetwork Then
strPIN = rstTemp!strPIN
strContract = rstTemp!strContract
strNetwork = rstTemp!strNetwork
rst.FindFirst ("[SAP_PIN] = '" & strPIN & "' AND [Contract] = '" & strContract & "' AND [Network] = '" & strNetwork & "'")
If Not rst.NoMatch Then
rst.Edit
rst!Allocated_Hrs = rstTemp!F38
rst.Update
End If
Else
rst.FindNext ("[SAP_PIN] = '" & strPIN & "' AND [Contract] = '" & strContract & "' AND [Network] = '" & strNetwork & "'")
If Not rst.NoMatch Then
rst.Edit
rst!Allocated_Hrs = rstTemp!F38
rst.Update
End If
End If
rstTemp.MoveNext
Loop
End If
Set rst = Nothing
Set rstTemp = Nothing
End Sub
i really need help thank you
Is this what you are doing?
UPDATE qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue
INNER JOIN tbl_HR_Contract_Detail ON
qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue.SAP_PIN = tbl_HR_Contract_Detail.SAP_PIN
AND qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue.Contract = tbl_HR_Contract_Detail.Contract
AND qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue.Network = tbl_HR_Contract_Detail.Network
SET tbl_HR_Contract_Detail.Allocated_Hrs = qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue.F38;
You set Allocated_HrstoF38 where SAP_PIN,Contract and Network are equal?
SAP_PIN,Contract and Network are combined unique in qry_HR_temp_Consultant_Data_DuplicateNetwork_EachValue?
Using SQL Server Express 2014 with Access 2016
Front end contains a form intended to be used to search for records in the database. The VBA code on the submit for the form builds the WHERE of the SELECT statement as one long string.
This is an abbreviated example.
Set thisDb = DBEngine.Workspaces(0).Databases(0)
Set qDef = thisDb.CreateQueryDef("tempPTQ")
qDef.Connect = "ODBC;Driver={ODBC Driver 11 for SQL Server};SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes;"
strFields = "field1, field2, field3"
strTable = "dbo_SomeTable"
strParam = "WHERE field1=" & txtBox1.Value & ", AND field2=" & txtBox2.Value & ", AND field3=" & txtBox3.Value
strSQL = "SELECT " & strFields & " FROM " & strTable & " WHERE " & strParam & ";"
qDef.SQL = strSQL
DoCmd.RunSQL "INSERT INTO " & strDestTbl & " SELECT * FROM tempPTQ"
Is it possible to convert this to an ADODB parameterized query with a dynamic WHERE clause, essentially a variable number of columns, each represented by a different parameter?
strSQL = "SELECT field1, field2, field3 FROM someTable"
Set dbCon = New ADODB.Connection
With dbCon
.ConnectionString = "Driver={SQL Server Native Client 11.0};SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes;"
.Open
End With
Set dbCmd = New ADODB.Command
With dbCmd
.ActiveConnection = dbCon
.CommandText = strSQL
If txtBox1.Value <> "" Then
.CreateParameter("param1", adChar)
.Parameters(0).Value = txtBox1.Value
End If
If txtBox2.Value <> "" Then
.CreateParameter("param2", adChar)
.Parameters(1).Value = txtBox2.Value
End If
If txtBox3.Value <> "" Then
.CreateParameter("param3", adChar)
.Parameters(2).Value = txtBox3.Value
End If
Set rst = .Execute()
rst.Close
Set rst = Nothing
End With
How can parameters be dynamically added to the WHERE clause?
Consider using a collection that holds the WHERE clause statement with ? placeholders and a dictionary of corresponding parameters:
Private Function FilterCriteria() As Collection
Dim sqlCollection As New Collection
Dim strCriteria As String
Dim params As Object
Set params = CreateObject("Scripting.Dictionary")
strCriteria = "1 = 1" ' ALWAYS TRUE CONDITION TO START WHERE CLAUSE
If txtBox1.Value <> "" Then
strCriteria = strCriteria & " AND field1 = ?"
params.Add "field1param", txtBox1.Value
End If
If txtBox2.Value <> "" Then
strCriteria = strCriteria & " AND field2 = ?"
params.Add "field2param", txtBox2.Value
End If
If txtBox3.Value <> "" Then
strCriteria = strCriteria & " AND field3 = ? "
params.Add "field3param", txtBox3.Value
End If
sqlCollection.Add strCriteria
sqlCollection.Add params
Set FilterCriteria = sqlCollection
End Function
Then in your actual database call, retrieve above function's returned collection and use in prepared statement and .CreateParameters:
Dim sqlCollection As New Collection
Set sqlCollection = FilterCriteria ' CALLING ABOVE FUNCTION (RETURNED COLLECTION)
Set dbCon = New ADODB.Connection
With dbCon
.ConnectionString = "Driver={SQL Server Native Client 11.0};SERVER=" & _
stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes;"
.Open
End With
' CONCATENATE WHERE CLAUSE STRING TO SQL STATEMENT
strSQL = "SELECT field1, field2, field3 FROM someTable WHERE " & sqlCollection(1)
Set dbCmd = New ADODB.Command
With dbCmd
.ActiveConnection = dbCon
.CommandText = strSQL
' BIND PARAMETERS FROM PARAMS DICT (KEYS=NAME, VALUES=PARAM VALUE)
For Each key In sqlCollection(2).keys
cmd.Parameters.Append cmd.CreateParameter(key, adVarChar, adParamInput, 255, _
sqlCollection(2)(key))
Next key
Set rst = .Execute()
rst.Close
Set rst = Nothing
End With
I have an Access form to edit records in a SQL Server 2008 R2 table.
There are 3 fields in the form which could be updated, but it may be that one or all 3 fields still are empty (Null), so the update is to set values the first time.
If the fields are NULL at the time it want to run the stored procedure and I add values for the first time the stored procedure fails with missing parameters.
The stored procedure looks like this:
ALTER PROCEDURE [dbo].[spAlarmprotokollaendern]
#FibuNr nvarchar(10)=Null,
#FibuNr_alt nvarchar(10),
#Preis decimal(5,2),
#Preis_alt decimal(5,2)=null,
#Alarmnummer int,
#Kennung nvarchar(10),
#Verrechnungsintervall int=null,
#Verrechnungsintervall_alt int=null,
#UserID int=null,
#Objektname nvarchar(50)=null,
#Objektstrasse nvarchar(60)=null,
#ObjektPLZ nvarchar(6)=null,
#Objektort nvarchar(50)=null,
#Kostenstelle int,
#Objektnummer int
UPDATE tblAlarmprotokolle
SET Fibunr = coalesce(#Fibunr, #Fibunr_alt),
Preis = coalesce(#Preis, #Preis_alt),
Verrechnungsintervall = coalesce(#Verrechnungsintervall, #Verrechnungsintervall_alt)
WHERE
(Alarmnummer >= #Alarmnummer AND Kennung = #Kennung)
OR (abgerechnet = 0 AND Kennung = #Kennung)
I use coalesce to check any new value for the field and the set the old field. But if the old field is NULL then it fails.
How can I make this work?
Thanks
Michael
The placeholder for an optional parameter value of a T-SQL stored procedure is the DEFAULT keyword. So, if your Access code is generating the following pass-through query call which is failing
EXEC dbo.spAlarmprotokollaendern '11150', '', 56.7, , 32627471 ...
then have it insert the DEFAULT keyword if the corresponding Access value is null:
EXEC dbo.spAlarmprotokollaendern '11150', '', 56.7, DEFAULT, 32627471 ...
Note that your EXEC statement must include the bare keyword DEFAULT, not the string value 'DEFAULT', for example
Option Compare Database
Option Explicit
Sub SO32779923()
Dim myFibunr, myFibunr_alt, myPreis, myPreis_alt, _
myAlarmnummer, myKennung, _
myVerrechnungsintervall, myVerrechnungsintervall_alt, _
myUserID, myObjektname, myObjektstrasse, myObjektPLZ, _
myObjektort, myKostenstelle, myObjektnummer
myFibunr = "11150"
myFibunr_alt = ""
myPreis = 56.7
myPreis_alt = Null
myAlarmnummer = 32627471
myKennung = "update_me"
myVerrechnungsintervall = 4
myVerrechnungsintervall_alt = Null
myUserID = 0
myObjektname = "x"
myObjektstrasse = "x"
myObjektPLZ = "x"
myObjektort = "x"
myKostenstelle = 0
myObjektnummer = 0
Dim spCall As String
spCall = "EXEC dbo.spAlarmprotokollaendern " & _
prepForSp(myFibunr) & ", " & _
prepForSp(myFibunr_alt) & ", " & _
prepForSp(myPreis) & ", " & _
prepForSp(myPreis_alt) & ", " & _
prepForSp(myAlarmnummer) & ", " & _
prepForSp(myKennung) & ", " & _
prepForSp(myVerrechnungsintervall) & ", " & _
prepForSp(myVerrechnungsintervall_alt) & ", " & _
prepForSp(myUserID) & ", " & _
prepForSp(myObjektname) & ", " & _
prepForSp(myObjektstrasse) & ", " & _
prepForSp(myObjektPLZ) & ", " & _
prepForSp(myObjektort) & ", " & _
prepForSp(myKostenstelle) & ", " & _
prepForSp(myObjektnummer)
Debug.Print spCall
Dim cdb As DAO.Database
Set cdb = CurrentDb
Dim qdf As DAO.QueryDef
Set qdf = cdb.CreateQueryDef("")
qdf.Connect = "ODBC;DSN=myDb"
qdf.sql = spCall
qdf.ReturnsRecords = False
qdf.Execute
Set qdf = Nothing
End Sub
Private Function prepForSp(thing As Variant) As String
If IsNull(thing) Then
prepForSp = "DEFAULT"
Else
Select Case VarType(thing)
Case vbString:
prepForSp = "'" & Replace(thing, "'", "''") & "'"
Case vbDate:
prepForSp = "'" & Format(thing, "yyyy-mm-dd Hh:Nn:Ss") & "'"
Case Else
prepForSp = CStr(thing)
End Select
End If
End Function
The Debug.Print statement displays
EXEC dbo.spAlarmprotokollaendern '11150', '', 56.7, DEFAULT, 32627471, 'update_me', 4, DEFAULT, 0, 'x', 'x', 'x', 'x', 0, 0