How to create a loop to upload from Excel into PostgresSQL table - vba

I have an excel table and a Postgres table that match identically. So far I wrote code that will successfully insert the first line in the excel table into the Postgres table. What I need help with is creating a loop to do this until it reaches the final row of the excel range. I've tried some things but can't seem to get it to work. The code is here below:
Also open to other ideas for doing this more efficiently. If there is a different way to do this, it would be great, because if you have a table with a ton of columns this process would be really inefficient.
Sub Upload_Records()
'Open Connection
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command
Set conn = New ADODB.Connection
conn.ConnectionString = "DSN=vsbslgprd01;DATABASE=postgres;SERVER=vsbslgprd01.zmr.zimmer.com;PORT=5432;UID=breedenz;PWD=110percent;"
conn.Open
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandText = "insert into asset_management.expired_recalled values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
'Set Parameters (Columns)
Dim LRow As Long
Dim pm1 As ADODB.Parameter
Dim pm2 As ADODB.Parameter
Dim pm3 As ADODB.Parameter
Dim pm4 As ADODB.Parameter
Dim pm5 As ADODB.Parameter
Dim pm6 As ADODB.Parameter
Dim pm7 As ADODB.Parameter
Dim pm8 As ADODB.Parameter
Dim pm9 As ADODB.Parameter
Dim pm10 As ADODB.Parameter
Dim pm11 As ADODB.Parameter
Dim pm12 As ADODB.Parameter
Dim pm13 As ADODB.Parameter
Dim pm14 As ADODB.Parameter
Dim pm15 As ADODB.Parameter
Dim pm16 As ADODB.Parameter
Dim pm17 As ADODB.Parameter
Dim pm18 As ADODB.Parameter
Dim pm19 As ADODB.Parameter
Dim pm20 As ADODB.Parameter
Dim pm21 As ADODB.Parameter
Dim pm22 As ADODB.Parameter
Dim pm23 As ADODB.Parameter
Dim pm24 As ADODB.Parameter
Dim pm25 As ADODB.Parameter
Dim pm26 As ADODB.Parameter
Dim pm27 As ADODB.Parameter
Set pm1 = cmd.CreateParameter("run_date", adVarChar, adParamInput, 1000)
pm1.Value = Sheets("Load").Range("H3").Value
cmd.Parameters.Append pm1
Set pm2 = cmd.CreateParameter("legacy", adVarChar, adParamInput, 1000)
pm2.Value = Sheets("Load").Range("I3").Value
cmd.Parameters.Append pm2
Set pm3 = cmd.CreateParameter("bucket", adVarChar, adParamInput, 1000)
pm3.Value = Sheets("Load").Range("J3").Value
cmd.Parameters.Append pm3
Set pm4 = cmd.CreateParameter("terr", adVarChar, adParamInput, 1000)
pm4.Value = Sheets("Load").Range("K3").Value
cmd.Parameters.Append pm4
Set pm5 = cmd.CreateParameter("dist_name", adVarChar, adParamInput, 1000)
pm5.Value = Sheets("Load").Range("L3").Value
cmd.Parameters.Append pm5
Set pm6 = cmd.CreateParameter("site", adVarChar, adParamInput, 1000)
pm6.Value = Sheets("Load").Range("M3").Value
cmd.Parameters.Append pm6
Set pm7 = cmd.CreateParameter("team_name", adVarChar, adParamInput, 1000)
pm7.Value = Sheets("Load").Range("N3").Value
cmd.Parameters.Append pm7
Set pm8 = cmd.CreateParameter("location", adVarChar, adParamInput, 1000)
pm8.Value = Sheets("Load").Range("O3").Value
cmd.Parameters.Append pm8
Set pm9 = cmd.CreateParameter("contained_in", adVarChar, adParamInput, 1000)
pm9.Value = Sheets("Load").Range("P3").Value
cmd.Parameters.Append pm9
Set pm10 = cmd.CreateParameter("customer_number", adVarChar, adParamInput, 1000)
pm10.Value = Sheets("Load").Range("Q3").Value
cmd.Parameters.Append pm10
Set pm11 = cmd.CreateParameter("product_group", adVarChar, adParamInput, 1000)
pm11.Value = Sheets("Load").Range("R3").Value
cmd.Parameters.Append pm11
Set pm12 = cmd.CreateParameter("item", adVarChar, adParamInput, 1000)
pm12.Value = Sheets("Load").Range("S3").Value
cmd.Parameters.Append pm12
Set pm13 = cmd.CreateParameter("item_desc", adVarChar, adParamInput, 1000)
pm13.Value = Sheets("Load").Range("T3").Value
cmd.Parameters.Append pm13
Set pm14 = cmd.CreateParameter("lot", adVarChar, adParamInput, 1000)
pm14.Value = Sheets("Load").Range("U3").Value
cmd.Parameters.Append pm14
Set pm15 = cmd.CreateParameter("qty", adVarChar, adParamInput, 1000)
pm15.Value = Sheets("Load").Range("V3").Value
cmd.Parameters.Append pm15
Set pm16 = cmd.CreateParameter("expiration_date", adVarChar, adParamInput, 1000)
pm16.Value = Sheets("Load").Range("W3").Value
cmd.Parameters.Append pm16
Set pm17 = cmd.CreateParameter("ext_list", adVarChar, adParamInput, 1000)
pm17.Value = Sheets("Load").Range("X3").Value
cmd.Parameters.Append pm17
Set pm18 = cmd.CreateParameter("possible_financial_impact", adVarChar, adParamInput, 1000)
pm18.Value = Sheets("Load").Range("Y3").Value
cmd.Parameters.Append pm18
Set pm19 = cmd.CreateParameter("brand_code", adVarChar, adParamInput, 1000)
pm19.Value = Sheets("Load").Range("Z3").Value
cmd.Parameters.Append pm19
Set pm20 = cmd.CreateParameter("due_date", adVarChar, adParamInput, 1000)
pm20.Value = Sheets("Load").Range("AA3").Value
cmd.Parameters.Append pm20
Set pm21 = cmd.CreateParameter("scope", adVarChar, adParamInput, 1000)
pm21.Value = Sheets("Load").Range("AB3").Value
cmd.Parameters.Append pm21
Set pm22 = cmd.CreateParameter("charge", adVarChar, adParamInput, 1000)
pm22.Value = Sheets("Load").Range("AC3").Value
cmd.Parameters.Append pm22
Set pm23 = cmd.CreateParameter("eligible_item", adVarChar, adParamInput, 1000)
pm23.Value = Sheets("Load").Range("AD3").Value
cmd.Parameters.Append pm23
Set pm24 = cmd.CreateParameter("prod_release_dom_cde", adVarChar, adParamInput, 1000)
pm24.Value = Sheets("Load").Range("AE3").Value
cmd.Parameters.Append pm24
Set pm25 = cmd.CreateParameter("location_type", adVarChar, adParamInput, 1000)
pm25.Value = Sheets("Load").Range("AF3").Value
cmd.Parameters.Append pm25
Set pm26 = cmd.CreateParameter("container_type", adVarChar, adParamInput, 1000)
pm26.Value = Sheets("Load").Range("AG3").Value
cmd.Parameters.Append pm26
Set pm27 = cmd.CreateParameter("stock_type", adVarChar, adParamInput, 1000)
pm27.Value = Sheets("Load").Range("AH3").Value
cmd.Parameters.Append pm27
'Execute
cmd.Execute
conn.Close
End Sub

Without re-writing all of your code, I can tell you some tips to get you on the right track.
Your construct is wrong. It works for the one row, yes, of course, but it's not scalable. The proper construct would look like this:
Declare/Open Connection
Declare Command Object
Declare All Parameters
Loop rows
Assign parameter values
Execute command object
Close Connection
Also, the parameters will be part of a collection for the command, so you don't need to even access them by name; you can access the values as part of the command's collection (cmd.Parameters(1).Value =).
Another tip -- have a lot of rows? Use a transaction and do a single commit at the end.
That brings me to another point. Access the row values by Row, Column instead of range name. This way you can simply loop through the columns and assign the value by the row and column id (you are already looping rows).
Finally, #Belayer had the mic drop moment as well... avoid all of this pain and use copy. Not only is it easier, but it's significantly faster and more efficient on the database side than row by row inserts. I've never done it in VBA, but if you were using .NET it's native to the PostgreSQL superb Npgsql driver.
https://stackoverflow.com/a/66318417/1001884

Related

Stored Procedure results differ between SSMS and VBA

I have a stored procedure that returns a record set with 4 rows in SSMS.
Originally the - values were null, and I thought that might be the source of the error so I changed them to - hoping that would solve the problem. It didn't...
Result in SSMS:
When I execute that same stored procedure in Excel, the record set only returns 2 of the 4 rows:
Can someone please let me know what I'm missing here?
I use the technique frequently to return results from stored procedures in VBA, but I've never experienced this issue before, and I've tried everything I can think of.
VBA code calling the stored procedure:
Dim cn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim x As Variant
Dim FieldsToSelect(5) As Variant
FieldsToSelect(0) = "NC_ADD_TFC"
FieldsToSelect(1) = "NC_ADD_INDEX"
FieldsToSelect(2) = "OC_ADD_TFC"
FieldsToSelect(3) = "OC_ADD_INDEX"
FieldsToSelect(4) = "OC_LIKE_ADDTFC"
FieldsToSelect(5) = "OC_LIKE_ADDINDEX"
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=ID;Password = PASSWORD ;Data Source=Source;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Use Encryption for Data=False;Tag with column collation when possible=False"
cn.Open
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cn
.CommandType = adCmdStoredProc
.CommandText = "SP NAME"
.Parameters.Append .CreateParameter("#Model", adVarChar, adParamInput, 200, Model)
.Parameters.Append .CreateParameter("#Att", adVarChar, adParamInput, 200, Att)
.Parameters.Append .CreateParameter("#MastType", adVarChar, adParamInput, 200, MastType)
.Parameters.Append .CreateParameter("#TFC", adVarChar, adParamInput, 200, TFC)
.Parameters.Append .CreateParameter("#LineOnDate", adVarChar, adParamInput, 200, LineOnDate)
.Parameters.Append .CreateParameter("#SalesCode", adVarChar, adParamInput, 200, SalesCode)
.Parameters.Append .CreateParameter("#OrderOptions", adVarChar, adParamInput, 200, OrderOptions)
.Parameters.Append .CreateParameter("#OrderNumber", adVarChar, adParamInput, 200, OrderNumber)
End With
Set rs = cmd.Execute
ThisWorkbook.Sheets("ConfigComparison").Range("A3").CopyFromRecordset rs
x = rs.GetRows(Fields:=FieldsToSelect)
GetConfigsComp = x
cn.Close

When executing the stored procedure from VBA getting error "Procedure or function expects parameter #empid which is not passed"

I have written a stored procedure to insert the data into a table. When I execute that into SQL Server 2012 it works fine while in VBA throws error
procedure or function expects parameter #empid which was not provided
I tried to resolve with different combinations of connection strings, CommandType etc but it does not resolve. While code seems perfectly fine, please assist me to resolve it.
Stored procedure:
CREATE PROCEDURE [dbo].[spInsertDataIntoEmployee]
#empid INT,
#empname VARCHAR(20),
#empage INT,
#empsalary DECIMAL(8,2)
AS
BEGIN
SET NOCOUNT ON
INSERT INTO [dbo].[employee] (empid, empname, empage, empsalary)
VALUES (#empid, #empname, #empage, #empsalary)
END
VBA code:
Private Sub Exec_StoredProcFromExcel_Click()
Dim con As ADODB.Connection
Dim res As ADODB.Recordset
Dim mobjCmd As ADODB.Command
Dim strConn As String
Dim par1 As Object
Dim par2 As Object
Dim par3 As Object
Dim par4 As Object
'Dim empname As Varchar
'Dim empage As Integer
'Dim empsalary As Single
Dim indRecordSetFields As Integer
'Dim strQuery As String
'con.Close
Set con = New ADODB.Connection
Set res = New ADODB.Recordset
Set mobjCmd = New ADODB.Command
strConn = "Driver={SQL Server Native Client 11.0};Server=localhost;Database=test;Trusted_Connection=yes;"
'strConn = "Provider=SQLOLEDB; Data Source=localhost; Initial Catalog=test; Integrated Security=SSPI;"
con.Open strConn, adOpenStatic, adLockOptimistic
Set par1 = mobjCmd.CreateParameter("#empid", adInteger, adParamInput)
Set par2 = mobjCmd.CreateParameter("#empname", adVarChar, adParamInput, 30)
Set par3 = mobjCmd.CreateParameter("#empage", adInteger, adParamInput)
Set par4 = mobjCmd.CreateParameter("#empsalary", adDouble, adParamInput)
With mobjCmd
.ActiveConnection = con
.CommandText = "Exec [dbo].[spInsertDataIntoEmployee]"
.CommandType = 1 'adCmdStoredProc=4 does not work while adCmdText=1 and adCmdUnknown=8 both work for me
.CommandTimeout = 45
.Parameters.Append par1
.Parameters("#empid").Value = 111
.Parameters.Append par2
.Parameters("#empname").Value = "majid rajih"
.Parameters.Append par3
.Parameters("#empage").Value = 34
.Parameters.Append par4
.Parameters("#empsalary").Value = 200000
'.Parameters.Append .CreateParameter("#empid", adInteger, adParamInput, 111)
'.Parameters.Append .CreateParameter("#empname", adVarChar, adParamInput, 20, "majid khan")
'.Parameters.Append .CreateParameter("#empage", adInteger, adParamInput, 30)
'.Parameters.Append .CreateParameter("#empsalary", adSingle, adParamInput, 250000)
'.Parameters.Append .CreateParameter("#empid", adInteger, adParamInput, , ThisWorkbook.Sheets("employee").Range("A2").Value)
'.Parameters.Append .CreateParameter("#empname", adVarChar, adParamInput, 20, ThisWorkbook.Sheets("employee").Range("B2").Value)
'.Parameters.Append .CreateParameter("#empage", adInteger, adParamInput, , ThisWorkbook.Sheets("employee").Range("C2").Value)
'.Parameters.Append .CreateParameter("#empsalary", adSingle, adParamInput, , ThisWorkbook.Sheets("employee").Range("D2").Value)
' repeat as many times as you have parameters
.Execute
End With
'With res
'res.CursorType = adOpenStatic
'res.LockType = adLockOptimistic
'res.Open mobjCmd 'This executed the stored proc
'End With
End Sub
You are running the command in the text mode.
Your full query is Exec [dbo].[spInsertDataIntoEmployee] which does not include any parameters.
CommandType should be adCmdStoredProc, and CommandText should be the procedure name, without exec.
.CommandType = adCmdStoredProc
.CommandText = "[dbo].[spInsertDataIntoEmployee]"
If you want to keep adCmdText, list all parameters in the query:
.CommandType = adCmdText
.CommandText = "exec [dbo].[spInsertDataIntoEmployee] #empid, #empname, #empage, #empsalary"
.CommandText = "spInsertDataIntoEmployee"
And try to send everything as nvarchar.

VBA Access more than 2 CreateParameter

I need to create an Access program but I am having trouble.
Here is the problem.
When I type information as below picture, all of the information should be inserted to the Listbox. 'BlendID' and 'Blend Method' are same for all element and only 'Precursor's' information change. So when I typed two item of precursor, there need to be two rows but I only get 1 data in the list box.
(Precursor2's information should be inserted in listbox but it is not working now)
Here is my code
Private Sub AddToListBlend_Click()
Dim cmd As ADODB.Command
Dim conn As ADODB.Connection
Dim strConn As String
Dim par As ADODB.Parameter 'input
'Dim introw As Integer
'On Error GoTo errorhandle
'introw = ListBlend.ListIndex + 1
strConn = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;"
Set conn = New ADODB.Connection
conn.Open strConn 'open connection
If IsNull(TextRequestNo.value) Or TextRequestNo.value = "" Then
MsgBox ("Please select Request No first")
Else
Set cmd = New ADODB.Command
cmd.CommandText = "dbo.AddBlendPrac"
cmd.CommandType = adCmdStoredProc
cmd.ActiveConnection = conn
Set par = cmd.CreateParameter("#BlendID", adVarChar, adParamInput, 50, TextB10.value)
cmd.parameters.Append par
Set par = cmd.CreateParameter("#BlendMethod", adVarChar, adParamInput, 50, TextB11.value)
cmd.parameters.Append par
Set par = cmd.CreateParameter("#RequestID", adVarChar, adParamInput, 50, TextRequestNo.value)
cmd.parameters.Append par
Set par = cmd.CreateParameter("#SampleID", adVarChar, adParamInput, 50, TextB12.value)
cmd.parameters.Append par
Set par = cmd.CreateParameter("#WLocation", adVarChar, adParamInput, 50, WLocation1.value)
cmd.parameters.Append par
cmd.Execute
conn.Close 'close connection
Set conn = Nothing
Set cmd = Nothing
MsgBox "Succeeded"
List731.Requery
End If
End Sub
I am aware that I need to add Precursor2's information but I do not know how to do it. As you can see first information is inserted to the ListBox, but second one is not.
Would you please share your idea about this?

VBA: creating multiple parameters inside with/ end with statement

I have code that works with no errors. My question is more out of wanting to learn the syntax of a With/ End With statement that can include multiple parameters. Right now a new ADODB.Command is set and inside a With/ End With the ActiveConnection, the commandType, and the CommandText are included. Then outside the With 5 parameters are created, appended and assigned.
I was wondering if those parameters can also be inside the With/ End With of the ADODB.Command.
Here is my code:
Set ADOQD = New ADODB.Command
With ADOQD
.ActiveConnection = ADOCon
.CommandType = adCmdStoredProc
.CommandText = "jsp_AddFeedback"
End With
Set pArrangementID = CreateParameter("#ArrangementID", adVarChar, adParamInput, 15)
ADOQD.Parameters.Append pArrangementID
pArrangementID = Forms("MTDDataCheck").ArrangementID.Value
Set pEditor = ADOQD.CreateParameter("#Editor", adVarWChar, adParamInput, 20)
ADOQD.Parameters.Append pEditor
pEditor = gstrLastEditor
Set pProofer = ADOQD.CreateParameter("#Proofer", adVarWChar, adParamInput, 20)
ADOQD.Parameters.Append pProofer
pProofer = gstrLastProofer
Set pControlName = ADOQD.CreateParameter("#ControlName", adVarWChar, adParamInput, 255)
ADOQD.Parameters.Append pControlName
pControlName = lbl.name
Set pComment = ADOQD.CreateParameter("#Comment", adLongVarWChar, adParamInput, -1)
ADOQD.Parameters.Append pComment
pComment = reply
Here is my attempt:
Set ADOQD = New ADODB.Command
With ADOQD
.ActiveConnection = ADOCon
.CommandType = adCmdStoredProc
.CommandText = "jsp_DeleteFeedback"
Set pArrangementID = .CreateParameter("#ArrangementID", adVarChar, adParamInput, 15)
.Parameters.Append pArrangementID
pArrangementID = Forms("MTDDataCheck").ArrangementID.Value
Set pControlName = .CreateParameter("#ControlName", adVarWChar, adParamInput, 255)
.Parameters.Append pControlName
pControlName = lbl.name
.Execute
End With
Is this the correct way to do it? Any examples are much appreciated.
Thank you.
Code After getting response:
Set ADOQD = New ADODB.Command
With ADOQD
Set .ActiveConnection = ADOCon
.CommandType = adCmdStoredProc
.CommandText = "jsp_AddFeedback"
.Parameters.Append .CreateParameter("#ArrangementID", adVarChar, adParamInput, 15, Forms("MTDDataCheck").ArrangementID.Value)
.Parameters.Append .CreateParameter("#Editor", adVarWChar, adParamInput, 20, gstrLastEditor)
.Parameters.Append .CreateParameter("#Proofer", adVarWChar, adParamInput, 20, gstrLastProofer)
.Parameters.Append .CreateParameter("#ControlName", adVarWChar, adParamInput, 255, lbl.name)
.Parameters.Append .CreateParameter("#Comment", adLongVarWChar, adParamInput, -1, reply)
.Execute
End With
I would have thought
ADOQD.Parameters.Append pArrangementID
pArrangementID = Forms("MTDDataCheck").ArrangementID.Value
Would actually fail or replace the in-collection parameter with a string ...
Doesn't matter though as you don't need to explicitly create a parameter, supply the value along whith everything else:
Set ADOQD = New ADODB.Command
With ADOQD
SET .ActiveConnection = ADOCon
.CommandType = adCmdStoredProc
.CommandText = "jsp_AddFeedback"
.Parameters.Append .CreateParameter("#ArrangementID", adVarChar, adParamInput, 15, Forms("MTDDataCheck").ArrangementID.Value)
.Parameters.Append .CreateParameter("#Editor", adVarWChar, adParamInput, 20, gstrLastEditor)
...
End With

Save binary to sql

I'm trying to convert a pdf to binary dato and saving it to my SQL database. When i just output the pdf (from binary) to the user, it works perfectly.
The field in my database for the binary data is image.
Here is what i'm doing atm:
Set oFileStream = Server.CreateObject("ADODB.Stream")
oFileStream.Open
oFileStream.Type = 1 'Binary
oFileStream.LoadFromFile strPDF
And if i do Response.BinaryWrite(oFileStream.Read) the PDF pops to user.
Then i want to store it to SQL:
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "xxx"
strSQL = "INSERT INTO vAnalysesHistory (datetime,chosendatetime,companyid,code,content) VALUES (?,?,?,?,?)"
Set cmd = Server.CreateObject("ADODB.Command")
Set cmd.ActiveConnection = Conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
cmd.Parameters.Append cmd.CreateParameter("#datetime", adDate, adParamInput, 255, now)
cmd.Parameters.Append cmd.CreateParameter("#chosendatetime", adDate, adParamInput, 255, Request.Form("date"))
cmd.Parameters.Append cmd.CreateParameter("#companyid", adVarChar, adParamInput, 255, Request.Form("companyid"))
cmd.Parameters.Append cmd.CreateParameter("#code", adVarChar, adParamInput, 255, Request.Form("code"))
cmd.Parameters.Append cmd.CreateParameter("#content", adLongVarBinary, adParamInput, 8000, oFileStream.Read)
cmd.Execute()
Conn.close
Set Conn = Nothing
And i just get this error:
Application uses a value of the wrong type for the current operation.
I've tried a bunch of other things also with some other errors.
Read the stream into a Byte first, and then pass the Byte variable to the #content parameter
Based on what Vidar said, see the section "Uploading Image File to a Database" here:
http://www.beansoftware.com/ASP.NET-Tutorials/Save-Read-Image-Database.aspx