Generate INSERT INTO statements in MS-Access - sql

I like to export data (single records) from one Access database to another one in another country. The idea is that I want to send a text file with INSERT INTO statements per email and the receiving PC just executes these INSERT INTO statements. I wrote already the code to read and execute the INSERT INTO statements in these text files.
Obviously I have to generate the INSERT INTO statements.
Here is an example.
I have the following table:
Table1
Id number
PersonName text
DoB date, can be empty
NumberOfChildern number, can be empty
I select the data like this:
SELECT Id, PersonName, DoB, NumberOfChildern FROM Table1;
What I want to generate are statements like this:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
If all fields are always filled in then I could write one time the code and that's it. But there is a problem if a couple of fields might contain data or maybe no data.
Here are some similar but different versions of the above statement:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
INSERT INTO Table1 (Id, PersonName, NumberOfChildern ) VALUES (1, ‘Peter’, 1)
INSERT INTO Table1 (Id, PersonName, DoB ) VALUES (1, ‘Peter’, #5-17-1990#)
INSERT INTO Table1 (Id, PersonName ) VALUES (1, ‘Peter’)
With just two fields which can contain NULL values there are already 4 different versions of this statement and with more fields it becomes more and more complicated (not really complicated but more work).
I think about writing code in VBA which analyzes the table and the records which I want to export to check which kind of fields are used (i.e. date) and then generate statements like above.
I am sure I can do this but I wonder if maybe others did this before.
I don't want to reinvent the wheel.
But searching for "generate SQL insert statements" is not really efficient.
Any ideas?

It's your lucky day. I have done this for SQL Server - with a few modifications done below it should work for Access SQL.
The key is to insert VALUES NULL, not create different statements if values are null.
The SET IDENTITY_INSERT ON/OFF probably isn't needed for Access.
Gustav has posted a generic function that can replace all Sqlify/SqlDate etc. helper functions and covers more data types.
Public Sub InsertStatementsSql(ByVal sTABLE As String)
Dim DB As DAO.Database
Dim TD As DAO.TableDef
Dim RS As DAO.Recordset
Dim fld As DAO.Field
Dim sKpl As String
Dim sStart As String
Dim sValues As String
Dim S As String
Dim v As Variant
Dim i As Long
Dim bIdentity As Boolean
Set DB = CurrentDb
Set TD = DB.TableDefs(sTABLE)
Set RS = DB.OpenRecordset(sTABLE, dbOpenSnapshot)
' Check for Autonumber/IDENTITY column
bIdentity = False
For i = 0 To TD.Fields.count - 1
If (TD.Fields(i).Attributes And dbAutoIncrField) > 0 Then
bIdentity = True
Exit For
End If
Next i
If bIdentity Then
sKpl = sKpl & "SET IDENTITY_INSERT " & sTABLE & " ON;" & vbCrLf & vbCrLf
End If
' "INSERT INTO ... VALUES " for every line
For i = 0 To TD.Fields.count - 1
sStart = StrAppend(sStart, TD.Fields(i).Name, ", ")
Next i
sStart = "INSERT INTO " & sTABLE & " (" & sStart & ") VALUES "
' One line per record
Do While Not RS.EOF
sValues = ""
For i = 0 To TD.Fields.count - 1
v = RS(i)
If IsNull(v) Then
S = "NULL"
Else
Set fld = TD.Fields(i)
Select Case fld.Type
Case dbText, dbMemo: S = Sqlify(CStr(v))
Case dbDate: S = SqlDate(CDate(v))
Case dbDouble, dbSingle: S = SqlNumber(CDbl(v))
Case Else: S = CStr(v)
End Select
End If
sValues = StrAppend(sValues, S, ", ")
Next i
' Append line to full SQL
sKpl = sKpl & vbCrLf & sStart & " (" & sValues & ");"
RS.MoveNext
Loop
RS.Close
Set TD = Nothing
If bIdentity Then
sKpl = sKpl & vbCrLf & vbCrLf & "SET IDENTITY_INSERT " & sTABLE & " OFF;" & vbCrLf
End If
Debug.Print sKpl
' see https://support.microsoft.com/en-us/kb/210216 or https://msdn.microsoft.com/en-us/library/office/ff192913.aspx
' or https://stackoverflow.com/a/25431633/3820271
'ClipBoard_SetData sKpl
End Sub
' ------------------- helper functions -----------------
' ein'string --> 'ein''string'
Public Function Sqlify(ByVal S As String) As String
S = Replace(S, "'", "''")
S = "'" & S & "'"
Sqlify = S
End Function
Public Function SqlDate(vDate As Date) As String
SqlDate = "#" & Format(vDate, "yyyy-mm-dd") & "#"
End Function
Public Function SqlNumber(num As Double) As String
SqlNumber = Replace(CStr(num), ",", ".")
End Function
Public Function StrAppend(sBase As String, sAppend As Variant, sSeparator As String) As String
If Len(sAppend) > 0 Then
If sBase = "" Then
StrAppend = Nz(sAppend, "")
Else
StrAppend = sBase & sSeparator & Nz(sAppend, "")
End If
Else
StrAppend = sBase
End If
End Function

Related

Getting ODBC - System Resources Exceeded (Rutime error 3035)

Need some assistance. I took Gord Thompson's code here How to increase performance for bulk INSERTs to ODBC linked tables in Access? and modified it to fit my case.
I am trying to copy the contents of a query called 'bulk_insert' (which is based on a local table in MS Access DB) into a SQL linked table called dbo_tblCVR_Matching_tmp. The query has no calculated fields or functions or nothing, just 102 columns of plain data. I'm currently testing with files in the range of 6K to 10K records.
The code executes and it copies many records over before I get the error in the title of this thread. I have looked around, but there is nothing that would help me with my particular issue. Not sure if I have to clear or refresh something. Here is the 2 routines I'm using:
'==============================================================
'Gord Thompson Stackoverflow: https://stackoverflow.com/questions/25863473/how-to-increase-performance-for-bulk-inserts-to-odbc-linked-tables-in-access
'==============================================================
Sub bulk_insert()
Dim cdb As DAO.Database
Dim rst As DAO.Recordset
Dim t0 As Single
Dim i As Long
Dim c As Long
Dim valueList As String
Dim separator As String
Dim separator2 As String
t0 = Timer
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT * FROM bulk_insert", dbOpenSnapshot)
i = 0
valueList = ""
separator = ""
Do Until rst.EOF
i = i + 1
valueList = valueList & separator & "("
separator2 = ""
For c = 0 To rst.Fields.Count - 1
valueList = valueList & separator2 & "'" & rst.Fields(c) & "'"
If c = 0 Then
separator2 = ","
End If
Next c
valueList = valueList & ")"
If i = 1 Then
separator = ","
End If
If i = 1000 Then
SendInsert valueList
i = 0
valueList = ""
separator = ""
End If
rst.MoveNext
Loop
If i > 0 Then
SendInsert valueList
End If
rst.Close
Set rst = Nothing
Set cdb = Nothing
Debug.Print "Elapsed time " & Format(Timer - t0, "0.0") & " seconds."
End Sub
'==============================================================
Sub SendInsert(valueList As String)
Dim cdb As DAO.Database
Dim qdf As DAO.QueryDef
Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")
qdf.Connect = cdb.TableDefs("dbo_tblCVR_Matching_tmp").Connect
qdf.ReturnsRecords = False
qdf.sql = "INSERT INTO dbo.tblCVR_Matching_tmp (" & _
"Associate_Id , Recd_Date, Price_Sheet_Eff_Date, VenAlpha, Mfg_Name, Mfg_Model_Num, Fei_Alt1_Code, Mfg_Product_Num, Base_Model_Num, Product_Description," & _
"Qty_Base_UOM , Price_Invoice_UOM, Mfr_Pub_Sugg_List_Price, Mfr_Net_Price, IMAP_Pricing, Min_Order_Qty, UPC_GTIN, Each_Weight, Each_Length, Each_Width," & _
"Each_Height, Inner_Pack_GTIN_Num, Inner_Pack_Qty, Inner_Pack_Weight, Inner_Pack_Length, Inner_Pack_Width, Inner_Pack_Height, Case_GTIN_Num, Case_Qty," & _
"Case_Weight, Case_Length, Case_Width, Case_Height, Pallet_GTIN_Num, Pallet_Qty, Pallet_Weight, Pallet_Length, Pallet_Width, Pallet_Height, Pub_Price_Sheet_Eff_Date," & _
"Price_Sheet_Name_Num, Obsolete_YN, Obsolete_Date, Obsolete_Stock_Avail_YN, Direct_Replacement, Substitution, Shelf_Life_YN, Shelf_Life_Time, Shelf_Life_UOM," & _
"Serial_Num_Req_YN, LeadLaw_Compliant_YN, LeadLaw_3rd_Party_Cert_YN, LeadLaw_NonPotable_YN, Compliant_Prod_Sub, Compliant_Prod_Plan_Ship_Date, Green, GPF, GPM," & _
"GPC, Freight_Class, Gasket_Material, Battery_YN, Battery_Type, Battery_Count, MSDS_YN, MSDS_Weblink, Hazmat_YN, UN_NA_Num, Proper_Shipping_Name," & _
"Hazard_Class_Num, Packing_Group, Chemical_Name, ORMD_YN, NFPA_Storage_Class, Kit_YN, Load_Factor, Product_Returnable_YN, Product_Discount_Category," & _
"UNSPSC_Code, Country_Origin, Region_Restrict_YN, Region_Restrict_Regulations, Region_Restrict_States, Prop65_Eligibile_YN, Prop65_Chemical_Birth_Defect," & _
"Prop65_Chemical_Cancer, Prop65_Chemical_Reproductive, Prop65_Warning, CEC_Applicable_YN, CEC_Listed_YN, CEC_Model_Num, CEC_InProcess_YN, CEC_Compliant_Sub," & _
"CEC_Compliant_Sub_Cross_YN, Product_Family_Name, Finish, Kitchen_Bathroom, Avail_Order_Date, FEI_Exclusive_YN, MISC1, MISC2, MISC3" & _
") Values " & valueList
'this is the line that is always highlighted when the error occurs
qdf.Execute dbFailOnError
Set qdf = Nothing
Set cdb = Nothing
End Sub
This is the final version of the code after testing it a million times, just in case someone runs into my same issue. Again thx to Albert Kallal for helping me out on this.
I added some comments in the code as well as additional information to get this thing working on one go.
In my case,
I took care of any duplicates before querying the records (i.e. I created an append query to copy the records to a local table with a primary key)
Created a pass through query 'p'
Used a function to help me escape chars such as the single quote char and deal with nulls and blanks
Integrated a dlookup function to prevent me from going crazy on hard coding the names of every column on my query. Also to allow filtering of empty columns to maximize the use of the chunk size
' =============================================================
' Credit to Albert Kallal Getting ODBC - System Resources Exceeded (Rutime error 3035)
' =============================================================
Sub bulk_insert()
Dim rstLocal As DAO.Recordset
Set rstLocal = CurrentDb.OpenRecordset("bi") 'bi is the name of the query I'm using to list of the records in the bulk
Dim sBASE As String ' base sql insert string
Dim sValues As String ' our values() list built up
Dim t As Single
t = Timer
Dim i As Long
Dim j As Long
Dim c As Long
Dim ChunkSize As Long ' # length size of "text" to send to server
Dim separator2 As String
Dim potentialHeader As String
Dim test
Dim filledArray() As Long
ChunkSize = 48000 'chunk size / or number of chars
'Try to programmatically create the insert, we will also remove anything that doesn't have values
With rstLocal
If Not rstLocal.EOF Then
sBASE = "INSERT INTO dbo.tblCVR_Matching_tmp (" 'this is where I added my SQL table
ReDim filledArray(0 To .Fields.Count - 1)
separator2 = ""
For c = 0 To .Fields.Count - 1 'using loop to get all the headers in my query
potentialHeader = .Fields(c).Name
test = DLookup(potentialHeader, "bi", potentialHeader & " is not null") 'using the dlookup function to isolate headers from my query that have values in its column
If test <> "" Then
filledArray(c) = 1
sBASE = sBASE & separator2 & potentialHeader
separator2 = ","
Else
filledArray(c) = 0
End If
Next c
sBASE = sBASE & ") VALUES "
End If
End With
Dim RowsInChunk As Long ' this will show rows that fit into a chunk
Dim RowCountOut As Long
sValues = ""
Do While rstLocal.EOF = False
RowCountOut = RowCountOut + 1
If sValues <> "" Then sValues = sValues & ","
RowsInChunk = RowsInChunk + 1
sValues = sValues & "("
separator2 = ""
With rstLocal
For c = 0 To .Fields.Count - 1
If filledArray(c) = 1 Then
sValues = sValues & separator2 & sql_escape(.Fields(c)) 'using sql_escape function for cells that have 'null' or single quotes... the function helps escape the characters to avoid getting errors on the insert
separator2 = ","
Else
'SKIP IF ALL NULLS
End If
Next c
End With
sValues = sValues & ")"
If (Len(sBASE) + Len(sValues)) >= ChunkSize Then
'send data to server
With CurrentDb.QueryDefs("p")
.sql = sBASE & sValues
.Execute
End With
Debug.Print "Rows in batch = " & RowsInChunk 'displays the number of rows per batch sent on each bulk insert statement
RowsInChunk = 0
sValues = ""
DoEvents
End If
rstLocal.MoveNext
Loop
' send out last batch (if any)
If sValues <> "" Then
With CurrentDb.QueryDefs("p") 'using pass through query here. I named mine 'p'
.sql = sBASE & sValues
.Execute
End With
sValues = ""
End If
rstLocal.Close
t = Timer - t
Debug.Print "done - time = " & t 'displays information on the immediate window as to the total duration of the sub
End Sub
====this is the sql_escape function========
' detects if a values is string or null and properly escapes it
Public Function sql_escape(val As Variant)
If LCase(val) = "null" Or val = "" Or IsNull(val) Then
sql_escape = "NULL"
Else
' also need to escape "'" for proper sql
val = Replace(val, "'", "''")
sql_escape = "'" & val & "'"
End If
End Function
In your loop, put in a test for the value length.
I would trigger the insert at about 4000 characters, maybe try 8000.
Also, you want to use a pass-though query for this, else it will be slow.
So, the code will be say like you have, but make sure the output format is in t-sql (sql server) format, and not JET/ACE sql format.
Note that sql server DOES have a short hand for inserts, and we WANT to use that fact since this reduces the overhead (the sql syntax) by a large amount (and looking at your code, you DO seem to be doing this).
So, the formart we want is this:
INSERT INTO tblBig (ID, FirstName, LastName, City)
VALUES (134, 'Albert', 'Kallal', 'Edmonton'),
VALUES (134, 'Albert', 'Kallal', 'Edmonton'),
VALUES (134, 'Albert', 'Kallal', 'Edmonton');
Note how we only need ONE insert command for many rows.
So, our code stub will look like this:
Sub TestAppendNeedForSpeed()
' I wanted to allow PK inserts
With CurrentDb.QueryDefs("qryPass1")
.SQL = "SET IDENTITY_INSERT TBLbIG1 ON;"
.Execute
End With
Dim rstLocal As dao.Recordset
Set rstLocal = CurrentDb.OpenRecordset("tblBig")
Dim sBASE As String ' base sql insert string
Dim sValues As String ' our values() list built up
Dim t As Single
t = Timer
Dim i As Long
Dim j As Long
Dim ChunkSize As Long ' # length size of "text" to send to server
ChunkSize = 4000 ' I don't think going higher will help
sBASE = "INSERT INTO tblBig1 (ID,FirstName,LastName,City) VALUES "
Dim RowsInChunk As Long ' this will show rows that fit into a chunk - only FYI
Dim RowCountOut As Long
sValues = ""
Do While rstLocal.EOF = False
RowCountOut = RowCountOut + 1
If sValues <> "" Then sValues = sValues & ","
RowsInChunk = RowsInChunk + 1
With rstLocal
sValues = sValues & "(" & !ID & "," & qu(!FirstName) & "," & qu(!LastName) & "," & qu(!City) & ")"
End With
If (Len(sBASE) + Len(sValues)) >= ChunkSize Then
' send data to server
With CurrentDb.QueryDefs("qryPass1")
.SQL = sBASE & sValues
.Execute
End With
Debug.Print "(" & RowCount & ") -- buffer out - " & RowsInChunk
RowsInChunk = 0
sValues = ""
DoEvents
End If
rstLocal.MoveNext
Loop
' send out last batch (if any)
If sValues <> "" Then
With CurrentDb.QueryDefs("qryPass1")
.SQL = sBASE & sValues
.Execute
End With
sValues = ""
End If
rstLocal.Close
t = Timer - t
Debug.Print "done - time = " & t
End Sub
So, the way we have this laid out, we can set/tweak/test/try the best chunk size.
You not even close and in the same ball part to insert 4000 rows at a time. Try about 4000 characters, maybe 8000. Some systems, I seen about 12000 char chunk size work best.
And as noted, use the above pass-though query idea - it will also run MUCH faster.
You can expect about 15x to 20x speed improvement with above. So, in place of say 120 minutes, you see about 6 minutes of time.
So, use the above template and approach. Of course the ONE row of values could be an external sub (or function) call, but the above approach will get you the best speed.

Is ther a Join function in vba to combine multiple fields rather than using concatenate function in access?

Thank you to all your responses.
I have a table with one id field and R1-R30 fields.
I was able to concatenate R1-R30 fields in a query using
Route: Trim([R1] & IIf([R2]="",""," ") & [R2] & IIf([R3]="",""," ") & [R3] & IIf([R4]="",""," ") & [R4] & IIf([R5]="",""," ") & [R5] & IIf([R6]="",""," ") & [R6] & IIf([R7]="",""," ") & [R7] & IIf([R8]="",""," ") & [R8] & IIf([R9]="",""," ") & [R9] & IIf([R10]="",""," ") & [R10] & IIf([R11]="",""," ") & [R11] & IIf([R12]="",""," ") & [R12] & IIf([R13]="",""," ") & [R13] & IIf([R14]="",""," ") & [R14] & IIf([R15]="",""," ") & [R15] & IIf([R16]="",""," ") & [R16] & IIf([R17]="",""," ") & [R17] & IIf([R18]="",""," ") & [R18] & IIf([R19]="",""," ") & [R19] & IIf([R20]="",""," ") & [R20] & IIf([R21]="",""," ") & [R21] & IIf([R22]="",""," ") & [R22] & IIf([R23]="",""," ") & [R23] & IIf([R24]="",""," ") & [R24] & IIf([R25]="",""," ") & [R25] & IIf([R26]="",""," ") & [R26] & IIf([R27]="",""," ") & [R27] & IIf([R28]="",""," ") & [R28] & IIf([R29]="",""," ") & [R29] & IIf([R30]="",""," ") & [R30])
My question is if the Join function I found can be applied to a query where the delimeter could be a spare, comma or slash.
Join (source_array,[delimiter])
Thanks
This would be the code to take all values of 1 single recordset into a bidimensional array, and then take those values into a unidimensional array (excluding null values, because null values cannot be joined with JOIN).
I think it would be better just looping trough every field with the loop, but in case it might help, i'll post it.
To replicate your issue, I just created a database with 1 single table with 2 records:
I'll concatenate all fields, excluding ID field. So with an easy query, I can get a recordset of 1 single record, using ID field as parameter:
SELECT Tabla1.Field1, Tabla1.Field2, Tabla1.Field3, Tabla1.Field4
FROM Tabla1
WHERE (((Tabla1.Id)=1));
And then the VBA code to Msgbox the fields joined, using a comma as delimiter.
Sub JOIN_RST()
Dim rst As Recordset
Dim vArray As Variant
Dim SingleArray() As Variant
Dim i As Long
Dim MySQL As String
Dim STRJoined As String
MySQL = "SELECT Tabla1.Field1, Tabla1.Field2, Tabla1.Field3, Tabla1.Field4 " & _
"FROM Tabla1 WHERE (((Tabla1.Id)=2));" 'query to get a single recordset.
Set rst = Application.CurrentDb.OpenRecordset(MySQL, 2, 4)
DoEvents
If rst.RecordCount > 0 Then
rst.MoveLast
rst.MoveFirst
vArray = rst.GetRows
ReDim SingleArray(UBound(vArray))
For i = 0 To UBound(SingleArray)
If IsNull(vArray(i, 0)) = True Then
SingleArray(i) = ""
Else
SingleArray(i) = vArray(i, 0)
End If
Next i
Debug.Print vArray(0, 0) 'Field 1
Debug.Print vArray(1, 0) 'Field 2
Debug.Print vArray(2, 0) 'Field 3
Debug.Print vArray(3, 0) 'Field 4
STRJoined = Join(SingleArray, ",")
Debug.Print STRJoined
End If
Set rst = Nothing
Erase vArray
Erase SingleArray
DoEvents
End Sub
If I execute this code using as WHERE parameter ID=1 , in debugger Window I get:
First Record
1
Null
My first record. Got a null value in Field 3 (it's empty)
First Record,1,,My first record. Got a null value in Field 3 (it's empty)
With ID=2 I get:
Second Record
2
Not null
Second Record
Second Record,2,Not null,Second Record
So this kinda works. I hope you can adapt it to your needs. but as i said. looking at the code, I think it would be easier just looping trough fields in a single query with all records. something like this:
Sub LOOPING_TROUGHT_FIELDS()
Dim RST As Recordset
Dim Joined_Records() As Variant
Dim i As Long
Dim MySQL As String
Dim STRJoined As String
Dim FLD As Field
MySQL = "SELECT Tabla1.Field1, Tabla1.Field2, Tabla1.Field3, Tabla1.Field4 " & _
"FROM Tabla1;" 'query to get all recordset you want to join
Set RST = Application.CurrentDb.OpenRecordset(MySQL, 2, 4)
DoEvents
If RST.RecordCount > 0 Then
RST.MoveLast
RST.MoveFirst
i = 0
ReDim Joined_Records(RST.RecordCount)
Do Until RST.EOF = True
For Each FLD In RST.Fields
If IsNull(FLD.Value) = True Then
STRJoined = STRJoined & "" & ","
Else
STRJoined = STRJoined & FLD.Value & ","
End If
Next FLD
Joined_Records(i) = Left(STRJoined, Len(STRJoined) - 1) 'we get 1 minus because there is an extra comma at end
i = i + 1
STRJoined = ""
RST.MoveNext
Loop
End If
Set RST = Nothing
Set FLD = Nothing
For i = 0 To UBound(Joined_Records) Step 1
Debug.Print Joined_Records(i)
Next i
Erase Joined_Records
End Sub
I don't know how many records you got. Try both and check how long does each option takes, and then choose 1.
Hope you can adapt all this to your needs. Welcome to SO.

Insert values from one table to another, better performance - Access 2000, VBA?

I have made this method:
Public Sub Proba()
Dim CPANonEmptyColumns As Integer
CPANonEmptyColumns = 0
Dim Max As Integer
Max = 0
Dim Koloni As String
Koloni = ""
Dim strSQL As String
Dim intI As Integer
Dim rsCPA As DAO.Recordset
Dim rsCPANezbirni As DAO.Recordset
Dim dbs_t1t2 As DAO.Database
On Error GoTo ErrorHandler
Set dbs_t1t2 = CurrentDb
'Open a recordset on all records from the Employees table that have
'a Null value in the ReportsTo field.
strSQL = "SELECT * FROM CPA_t1t2"
Set rsCPA = dbs_t1t2.OpenRecordset(strSQL) '//, dbOpenDynaset)
'If the recordset is empty, exit.
If rsCPA.EOF Then Exit Sub
intI = 1
With rsCPA
Do Until .EOF
DoCmd.RunSQL "INSERT INTO CPA_nezbirni (tipprod, promet) VALUES ('" & ![tipprod] & "', '" & ![promet] & "');"
' check individual column if it has a value and increment max if CPANonEmptyColumns
If ![t4k1] <> Null Or ![t4k1] <> "" Then
CPANonEmptyColumns = CPANonEmptyColumns + 1
Koloni = Koloni & "t4k1,"
End If
If ![t4k2] <> Null Or ![t4k2] <> "" Then
CPANonEmptyColumns = CPANonEmptyColumns + 1
Koloni = Koloni & "t4k2,"
End If
If ![t4k3] <> Null Or ![t4k3] <> "" Then
CPANonEmptyColumns = CPANonEmptyColumns + 1
Koloni = Koloni & "t4k3,"
End If
If CPANonEmptyColumns > Max Then
Max = CPANonEmptyColumns
End If
Debug.Print "Red: " & Str(intI) & " Max: " & Str(Max) & ", Koloni: " & Koloni
.Edit
.MoveNext
CPANonEmptyColumns = 0
Koloni = ""
intI = intI + 1
Loop
End With
rsCPA.Close
dbs_t1t2.Close
Set rsCPA = Nothing
Set dbs_t1t2 = Nothing
ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
Basically, I open two tables, CPA_t1t2 and CPA_nezbirni. I want to copy the appropriate values for the appropriate columns, tipprod and promet from CPA_t1t2 to CPA_nezbirni.
The problem is, the source table CPA_t1t2 has 18000 rows and it needs time to run all those "INSERT" queries with the statement:
DoCmd.RunSQL "INSERT INTO CPA_nezbirni (tipprod, promet) VALUES ('" & ![tipprod] & "', '" & ![promet] & "');"
I am always suspicions when it comes SQL about performance. Since it needed 3-4 minutes to finish the procedure and insert values into CPA_nezbirni, is the SQL more slower way to copy value from one table to another?
Is there better, faster way by using the procedure above and some VBA, trough the same "Do Until" loop?

In Access VBA, Find field name, insert column into table

I am trying to create a new table where the field name in the source file is a variable. For example, the ID field in the source data could be "ID" or "HB_REF_NO", Date of birth may be DoB, Date of Birth or Date_of_birth
I've made a code that searches for various field names and returns the column they are in but am struggling to transfer the data from those columns into a table
Here is the code, please excuse its no doubt brutish methodology...
Private Sub cmdCompare_Click()
Set db = CurrentDb()
Set RecordSet1 = db.OpenRecordset("OriginalData")
Dim Fld As DAO.Field
Dim FldArray() As String
Dim i As Integer
Dim j As Integer
Dim SQLCreate As String
Dim SQLInsert As String
Dim s As Integer
Dim d As Integer
Dim b As Integer
Dim p As Integer
j = RecordSet1.Fields.Count - 1
ReDim FldArray(j)
'Assigns field names to the array
For Each Fld In RecordSet1.Fields
FldArray(i) = Fld.Name
i = i + 1
Next
For i = 0 To j
If FldArray(i) = "Surname" Then
s = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "HB_REF_NO" Then
d = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "NC_DATE_OF_BIRTH" Then
b = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "POSTCODE" Then
p = i
End If
Next
SQLCreate = "CREATE TABLE OriginalComp" & _
"(ID varchar(255), Surname varchar(255), DoB varchar(255), Postcode varchar(255))"
DoCmd.RunSQL SQLCreate
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"VALUES ('" & FldArray(d) & "','" & FldArray(s) & "','" & FldArray(b) & "','" & FldArray(p) & "');"
DoCmd.RunSQL SQLInsert
End Sub
It would be simpler to examine the source table's TableDef.Fields collection and find the current names for each of your variable field names. You don't need to open the table as a Recordset and you don't need to use an array.
This example will find and use a birth date field whose name matches either *Dob* or *Date*Birth*. (If more than one field in the table could match those patterns, you'll need to substitute patterns which are more selective.)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strDateOfBirth As String
Dim strInsert As String
Set db = CurrentDb
Set tdf = db.TableDefs("OriginalData")
For Each fld In tdf.Fields
With fld
If .Name Like "*DoB*" Or .Name Like "*Date*birth*" Then
strDateOfBirth = .Name
End If
End With
Next
If Len(strDateOfBirth) > 0 Then
strInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"SELECT HB_REF_NO, Surname, [" & strDateOfBirth & "], POSTCODE " & _
"FROM OriginalData;"
Debug.Print strInsert '<- inspect this in Immediate window; Ctrl+g will take you there
db.Execute strInsert, dbFailOnError
Else
MsgBox "Birth date field not found!"
End If
Extend that example to deal with the HB_REF_NO vs. ID field.
The problem is here:
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"VALUES ('" & FldArray(d) & "','" & FldArray(s) & "','" & FldArray(b) & "','" & FldArray(p) & "');"
The FldArray variable is a list of all of the column names, so the dth entry will be the dth column name, which is why you are inserting column names instead of values!
If you want to insert into OriginalComp those values then why not do:
Private Sub cmdCompare_Click()
Set db = CurrentDb()
SQLCreate = "CREATE TABLE OriginalComp" & _
"(ID varchar(255), Surname varchar(255), DoB varchar(255), Postcode varchar(255))"
DoCmd.RunSQL SQLCreate
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"SELECT HB_REF_NO, Surname, NC_DATE_OF_BIRTH, POSTCODE " & _
"FROM OriginalData"
DoCmd.RunSQL SQLInsert
End Sub

Passing Nulls from Excel to SQL

I'm using a VBA Script to update a table in SQL, so far it works perfectly. The problem is when handling null values. Because the VBA script loops until the first column ends, some values are null in the worksheet, but they are placed as zeros in sql.
In Excel:
Name Last name Age
daniel mtz 22
jose mtz 25
John doe
Final result in SQL:
Name Last name Age
daniel mtz 22
jose mtz 25
John doe 0
Any thoughts on how I can tell the Macro or SQL to read them as null and not zero?
P.S, programming each column in sql to place null in the corresponding value is not an option, because this table will be changing constantly and I could have all columns filled, or just some, etc.
[UPDATE] Here is the code for the VBA:
Sub Macro_CargarSQL()
'VARIABLES
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
'Column variables
Dim sname, slastname, sage As String
'CONECTION TO SERVER Y BD
conn.Open "Provider=SQLOLEDB;Data Source=Termxgesvsql07\vfsitesamn;Initial Catalog=DW_PLCO;Integrated Security=SSPI;"
'Import into SQL
With Sheets("test")
'Start row 2
iRowNo = 2
'Delete previous
conn.Execute "delete from table"
'Loop for insert
Do Until .Cells(iRowNo, 1) = ""
sname = .Cells(iRowNo, 1)
slastname = .Cells(iRowNo, 2)
sage = .Cells(iRowNo, 3)
conn.Execute "insert into dbo.table (name, lastname,age ) values ('" & sname & "', '" & slastname & "', '" & sage & "')"
iRowNo = iRowNo + 1
Loop
End With
conn.Close
Set conn = Nothing
End Sub
One way I've done this is to create two SQL strings and do checks on the actually values.
You can do this as follows (generally this is a lot easier if you have an array as you can write an iteration through your values/fieldnames).
Do Until .Cells(iRowNo, 1) = ""
sName = .Cells(iRowNo, 1)
slastname = .Cells(iRowNo, 2)
sage = .Cells(iRowNo, 3)
Dim sqlStrStart As String
Dim sqlStrValues As String
Dim sqlStrFull As String
sqlStrStart = "insert into dbo.table ("
sqlStrValues = " values ("
'build string dynamically (generally I do this using parameters, but this will work)
If sName <> "" Then
sqlStrStart = sqlStrStart + "name,"
sqlStrValues = sqlStrValues + sName & ","
End If
If slastname <> "" Then
sqlStrStart = sqlStrStart + "lastname,"
sqlStrValues = sqlStrValues + slastname & ","
End If
If sName <> "" Then
sqlStrStart = sqlStrStart + "age,"
sqlStrValues = sqlStrValues + sage & ","
End If
'remove last comma
sqlStrStart = Left(sqlStrStart, Len(sqlStrStart) - 1)
sqlStrValues = Left(sqlStrValues, Len(sqlStrValues) - 1)
'close parenthesis
sqlStrStart = sqlStrStart & ")"
sqlStrValues = sqlStrValues & ")"
'combine
sqlStrFull = sqlStrStart + sqlStrValues + ";"
conn.Execute sqlStrFull
iRowNo = iRowNo + 1
Loop
The best way is to create a function that inspects whether a cell value is empty or not. When empty, output should be "null", but when not, enclose the value in between single quotes.
This function can also be used so you can escape values that has single quote in it (such as "O'Brien"). Otherwise, in your current code, you'll encounter a SQL error.
Here's the function:
Function toSQL(s)
If s = "" Then toSQL = "null" Else toSQL = "'" & Replace(s, "'", "''") & "'"
End Function
And here's the replacement Insert statement:
conn.Execute "insert into dbo.table (name, lastname,age ) values (" & toSQL(sname) & ", " & toSQL(slastname) & ", " & toSQL(sage) & ")"
If you consistently call the toSQL function, and also consistently define the column in the SQL database as nullable, you'll be set. If the data type is numeric, you may not want to call toSQL though.
Use this when setting a null value in Excel VBA, and pass that to the SQL parameter's value.
DBNull.Value