PDA

View Full Version : Solved: Help transfer excel table to access db



jwilder1
04-05-2008, 06:49 PM
I am trying to transfer data from excel table to access db table. The code I came up with produces a "INSERT INTO syntax error

Option Explicit
Private Const glob_DBPath = "C:\ATC\db1.mdb"
Sub AddOrder()
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim LR As Long
Dim X As Long
Dim OrderNo As Long
Dim ReSent As String
Dim SUPCNumber As Long
Dim OrdDate As Date
Dim Qty As Long
Dim OrigQty As String
Dim OnHand As String
Dim ParLevel As String
Dim SUPCDescription
Dim PackageSize
Dim SellUnitOfMeasure
Dim BrandName
Dim Source As String
Dim Sent As String
LR = ThisWorkbook.Sheets("OrdCpy").Range("A65536").End(xlUp).Row
Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
For X = 2 To LR
OrderNo = ThisWorkbook.Sheets("OrdCpy").Range("A" & CStr(LR)).Value
ReSent = CStr(ThisWorkbook.Sheets("OrdCpy").Range("B" & CStr(LR)).Value)
SUPCNumber = ThisWorkbook.Sheets("OrdCpy").Range("C" & CStr(LR)).Value
OrdDate = ThisWorkbook.Sheets("OrdCpy").Range("D" & CStr(LR)).Value
Qty = ThisWorkbook.Sheets("OrdCpy").Range("E" & CStr(LR)).Value
OrigQty = CStr(ThisWorkbook.Sheets("OrdCpy").Range("F" & CStr(LR)).Value)
OnHand = CStr(ThisWorkbook.Sheets("OrdCpy").Range("G" & CStr(LR)).Value)
ParLevel = CStr(ThisWorkbook.Sheets("OrdCpy").Range("H" & CStr(LR)).Value)
SUPCDescription = ThisWorkbook.Sheets("OrdCpy").Range("I" & CStr(LR)).Value
PackageSize = ThisWorkbook.Sheets("OrdCpy").Range("J" & CStr(LR)).Value
SellUnitOfMeasure = ThisWorkbook.Sheets("OrdCpy").Range("K" & CStr(LR)).Value
BrandName = ThisWorkbook.Sheets("OrdCpy").Range("L" & CStr(LR)).Value
Source = CStr(ThisWorkbook.Sheets("OrdCpy").Range("M" & CStr(LR)).Value)
Sent = CStr(ThisWorkbook.Sheets("OrdCpy").Range("N" & CStr(LR)).Value)

sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,Date,Qty" _
& ",SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName)" _
& " VALUES(OrderNo,SUPCNumber,OrdDate,Qty," _
& "SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName);"

' INSERT INTO Syntax Error this line
oConn.Execute sSQL

Next X

oConn.Close
Set oConn = Nothing

End Sub

I searched for an ADO example, but could only find a DAO example which produces a type mismatch error

Sub DAOFromExcelToAccess()
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\ATC\db1.mdb")

'Run time error 13, type mismatch this line
Set rs = db.OpenRecordset("TBLORDERS", dbOpenTable)


r = 2 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0

With rs
.AddNew ' create a new record
.Fields("Orderno") = Range("A" & r).Value
.Fields("Resent") = Range("B" & r).Value
.Fields("SUPCNumber") = Range("C" & r).Value
.Fields("Date") = Range("D" & r).Value
.Fields("Qty") = Range("E" & r).Value
.Fields("OrigQty") = Range("F" & r).Value
.Fields("OnHand") = Range("G" & r).Value
.Fields("ParLevel") = Range("H" & r).Value
.Fields("SUPCDescription") = Range("I" & r).Value
.Fields("PackageSize") = Range("J" & r).Value
.Fields("SellUnitOfMeasure") = Range("K" & r).Value
.Fields("BrandName") = Range("L" & r).Value
.Fields("Source") = Range("M" & r).Value
.Fields("Sent") = Range("M" & r).Value
.Update
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub



Thanks in advance for any help, Jim

tstav
04-05-2008, 10:45 PM
Take the variables out of the sSQL string's quotes to expose their values. Untested.



sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,Date,Qty" _
& ",SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & "," & OrdDate & "," & Qty & "," _
& SUPCDescription & "," & PackageSize & "," & SellUnitOfMeasure & "," & BrandName & ");"

jwilder1
04-05-2008, 11:45 PM
Thank you for your reply, tried it and same message

tstav
04-06-2008, 12:06 AM
OK, lets see...
1. Maybe declare all variables as specific type and not let them be variant
Dim SUPCDescription as ...
Dim PackageSize as ...
Dim SellUnitOfMeasure as ...
Dim BrandName as ...

2. You don't need the CStr(LR), LR is a long and it will work on its own.

3. Make sure the Database's fields are of the same type as the VBA variables.

4. It may be superfluous in some case but I would add the CStr, CLng and CDate to all variable assignments.
For x = 2 To LR
With ThisWorkbook.Sheets("OrdCpy")
OrderNo = CLng(.Range("A" & LR).Value)
ReSent = CStr(.Range("B" & LR).Value)
SUPCNumber = CLng(.Range("C" & LR).Value)
OrdDate = CDate(.Range("D" & LR).Value)
Qty = CLng(.Range("E" & LR).Value)
OrigQty = CStr(.Range("F" & LR).Value)
OnHand = CStr(.Range("G" & LR).Value)
ParLevel = CStr(.Range("H" & LR).Value)
SUPCDescription = .Range("I" & LR).Value '<- If number in Database, make it CLng
PackageSize = .Range("J" & LR).Value '<- Same as above
SellUnitOfMeasure = .Range("K" & LR).Value '<- Same as above
BrandName = .Range("L" & LR).Value '<- Same as above
Source = CStr(.Range("M" & LR).Value)
Sent = CStr(.Range("N" & LR).Value)
end with

sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,Date,Qty" _
& ",SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & "," & OrdDate & "," & Qty & "," _
& SUPCDescription & "," & PackageSize & "," & SellUnitOfMeasure & "," & BrandName & ");"

oConn.Execute sSQL
Next x

tstav
04-06-2008, 12:18 AM
Plus an edit to the sql string
You need to add single quotes to whichever variable is of type string
e.g. if SUPCDescription is a string, then write
",'" & SUPCDescription "',"

jwilder1
04-06-2008, 12:36 AM
Sub AddOrder()
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim LR As Long
Dim X As Long
Dim OrderNo As Long
Dim ReSent As Long
Dim SUPCNumber As Long
Dim OrdDate As Date
Dim Qty As Long
Dim OrigQty As Long
Dim OnHand As Long
Dim ParLevel As Long
Dim SUPCDescription As String
Dim PackageSize As String
Dim SellUnitOfMeasure As String
Dim BrandName As String
Dim Source As String
Dim Sent As String
LR = ThisWorkbook.Sheets("OrdCpy").Range("A65536").End(xlUp).Row
Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
For X = 2 To LR
With ThisWorkbook.Sheets("OrdCpy")
OrderNo = CLng(.Range("A" & LR).Value)
ReSent = CLng(.Range("B" & LR).Value)
SUPCNumber = CLng(.Range("C" & LR).Value)
OrdDate = CDate(.Range("D" & LR).Value)
Qty = CLng(.Range("E" & LR).Value)
OrigQty = CLng(.Range("F" & LR).Value)
OnHand = CLng(.Range("G" & LR).Value)
ParLevel = CLng(.Range("H" & LR).Value)
SUPCDescription = CStr(.Range("I" & LR).Value) '<- If number in Database, make it CLng
PackageSize = CStr(.Range("J" & LR).Value) '<- Same as above
SellUnitOfMeasure = CStr(.Range("K" & LR).Value) '<- Same as above
BrandName = CStr(.Range("L" & LR).Value) '<- Same as above
Source = CStr(.Range("M" & LR).Value)
Sent = CStr(.Range("N" & LR).Value)
End With

sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,Date,Qty" _
& ",SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & "," & OrdDate & "," & Qty & "," _
& SUPCDescription & "," & PackageSize & "," & SellUnitOfMeasure & "," & BrandName & ");"

oConn.Execute sSQL
Next X

oConn.Close
Set oConn = Nothing

End Sub

I believe I made all the changes you suggested, same error message.
I noticed, in the examples that I've looked at, the text fields are transferred in single quotes('), would that have any bearing on the SQL statement? Thanks, Jim

tstav
04-06-2008, 12:39 AM
See my post#5

jwilder1
04-06-2008, 12:50 AM
We crossed during the time I made changes, what I have so far:
Sub AddOrder()
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim LR As Long
Dim X As Long
Dim OrderNo As Long
Dim ReSent As Long
Dim SUPCNumber As Long
Dim OrdDate As Date
Dim Qty As Long
Dim OrigQty As Long
Dim OnHand As Long
Dim ParLevel As Long
Dim SUPCDescription As String
Dim PackageSize As String
Dim SellUnitOfMeasure As String
Dim BrandName As String
Dim Source As String
Dim Sent As String
LR = ThisWorkbook.Sheets("OrdCpy").Range("A65536").End(xlUp).Row
Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
For X = 2 To LR
With ThisWorkbook.Sheets("OrdCpy")
OrderNo = CLng(.Range("A" & LR).Value)
ReSent = CLng(.Range("B" & LR).Value)
SUPCNumber = CLng(.Range("C" & LR).Value)
OrdDate = CDate(.Range("D" & LR).Value)
Qty = CLng(.Range("E" & LR).Value)
OrigQty = CLng(.Range("F" & LR).Value)
OnHand = CLng(.Range("G" & LR).Value)
ParLevel = CLng(.Range("H" & LR).Value)
SUPCDescription = CStr(.Range("I" & LR).Value) '<- If number in Database, make it CLng
PackageSize = CStr(.Range("J" & LR).Value) '<- Same as above
SellUnitOfMeasure = CStr(.Range("K" & LR).Value) '<- Same as above
BrandName = CStr(.Range("L" & LR).Value) '<- Same as above
Source = CStr(.Range("M" & LR).Value)
Sent = CStr(.Range("N" & LR).Value)
End With

sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,Date,Qty" _
& ",SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & "," & OrdDate & "," & Qty & ",'" _
& SUPCDescription & "','" & PackageSize & "','" & SellUnitOfMeasure & "','" & BrandName & "');"

oConn.Execute sSQL
Next X

oConn.Close
Set oConn = Nothing

End Sub

tstav
04-06-2008, 01:08 AM
Wrong post. Sorry. Hope you didn't read it yet

tstav
04-06-2008, 01:25 AM
I built an example DB myself and replicated your case. It worked just fine.

jwilder1
04-06-2008, 01:32 AM
Here is the zipped db I am trying to transfer to, Thank you for the help so far. Jim

tstav
04-06-2008, 03:01 AM
Jim, I opened your .mdb and your .xls file
There were several things that needed change.

Some DB fields were numeric but you had declared them as strings in VBA.
I changed that and it worked but then it couldn't append more than one record due to the setting of 3 fields to KEY FIELDS (had to be unique). I changed that too, and I got it finally to work.

Check the new variable declarations one by one in the code I'm submitting, to find the changed ones.
Also check the Sent variable, it is boolean (True/false) not type string.
In Access remove the PRIMARY KEY setting from the fields, it won't allow duplicates. Hope I haven't forgotten anything...

Sub AddOrder()
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim LR As Long
Dim X As Long
Dim OrderNo As Long
Dim ReSent As Long
Dim SUPCNumber As Long
Dim OrdDate As Date
Dim Qty As Long
Dim OrigQty As Long
Dim OnHand As Long
Dim ParLevel As Long
Dim SUPCDescription As String
Dim PackageSize As String
Dim SellUnitOfMeasure As String
Dim BrandName As String
Dim Source As String
Dim Sent As Boolean

LR = ThisWorkbook.Sheets("OrdCpy").Range("A65536").End(xlUp).Row
Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
For X = 2 To LR
With ThisWorkbook.Sheets("OrdCpy")
OrderNo = CLng(.Range("A" & LR).Value)
ReSent = CLng(.Range("B" & LR).Value)
SUPCNumber = CLng(.Range("C" & LR).Value)
OrdDate = CDate(.Range("D" & LR).Value)
Qty = CLng(.Range("E" & LR).Value)
OrigQty = CLng(.Range("F" & LR).Value)
OnHand = CLng(.Range("G" & LR).Value)
ParLevel = CLng(.Range("H" & LR).Value)
SUPCDescription = CStr(.Range("I" & LR).Value)
PackageSize = CStr(.Range("J" & LR).Value)
SellUnitOfMeasure = CStr(.Range("K" & LR).Value)
BrandName = CStr(.Range("L" & LR).Value)
Source = CStr(.Range("M" & LR).Value)
If .Range("N" & LR).Value = False Then
Sent = False
ElseIf .Range("N" & LR).Value = True Then
Sent = True
End If
End With
sSQL = "INSERT INTO TBLORDERS(OrderNo,Resent,SUPCNumber,Qty," _
& "SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & ReSent & "," & SUPCNumber & "," & Qty & ",'" _
& SUPCDescription & "','" & PackageSize & "','" & SellUnitOfMeasure & "','" & BrandName & "');"

oConn.Execute sSQL
Next X

oConn.Close
Set oConn = Nothing

End Sub

jwilder1
04-06-2008, 04:53 AM
Thank you for your efforts thus far,

I noticed earlier that the Sent should be boolean, but since it wasn't included in the SQL statement to be transferred, it wouldn't effect it.

and

I see tranferring the date was removed


The db1 table was exported from a larger application, I doubt that I can alter the actual table, as far as the primary keys.

Thanks, Jim

tstav
04-06-2008, 05:38 AM
I see you deleted the comment of "last record was transferred 7 times".
That should mean you got that error (and changed the LR to X in the with...endwith part).
Ok.
As for the removing of the date, that was an oversight on my part. I'm looking at it now.
I'll get back to you.

tstav
04-06-2008, 06:11 AM
Hi Jim,
Enclose Date in square brackets [Date] (it's a darn reserved word for SQL) and add single quotes for the OrdDate in the SQL string like so
sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,[Date],Qty," _
& "SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & ",'" & OrdDate & "'," & Qty & ",'" _
& SUPCDescription & "','" & PackageSize & "','" & SellUnitOfMeasure & "','" & BrandName & "');"

Test it and let me know. Primary Keys don't need to change. Forget my earlier comment.

jwilder1
04-06-2008, 06:33 AM
Thank you very much, I will try the rest later tonight( have to go to my day job now)
Jim

tstav
04-06-2008, 06:40 AM
Have a good day then, Jim. It's 16:30 here, on the other side of the globe...

tstav
P.S.1 I noticed that the time was also transferred into the DB along with the date. In case you want only the date, include the following
OrdDate = CDate(Format(.Range("D" & X).Value, "mm/dd/yyyy"))
P.S.2 To make the assignment of the Sent variable shorter:
Sent = IIf(.Range("N" & X).Value = False, False, True)
' If .Range("N" & X).Value = False Then
' Sent = False
' ElseIf .Range("N" & X).Value = True Then
' Sent = True
' End If

jwilder1
04-06-2008, 10:21 PM
Looks like all changes were successful, Thank you very much for a valuable lesson. Please mark as solved. Here is the final code for those following

Option Explicit
Private Const glob_DBPath = "C:\ATC\db1.mdb"
Sub AddOrder()
Dim oConn As Object
Dim oRS As Object
Dim sSQL As String
Dim LR As Long
Dim X As Long
Dim OrderNo As Long
Dim ReSent As Long
Dim SUPCNumber As Long
Dim OrdDate As Date
Dim Qty As Long
Dim OrigQty As Long
Dim OnHand As Long
Dim ParLevel As Long
Dim SUPCDescription As String
Dim PackageSize As String
Dim SellUnitOfMeasure As String
Dim BrandName As String
Dim Source As String
Dim Sent As Boolean

LR = ThisWorkbook.Sheets("OrdCpy").Range("A65536").End(xlUp).Row
Set oConn = CreateObject("ADODB.Connection")
oConn.Open = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_DBPath & ";"
For X = 2 To LR
With ThisWorkbook.Sheets("OrdCpy")
OrderNo = CLng(.Range("A" & X).Value)
ReSent = CLng(.Range("B" & X).Value)
SUPCNumber = CLng(.Range("C" & X).Value)
OrdDate = CDate(Format(.Range("D" & X).Value, "mm/dd/yyyy"))
Qty = CLng(.Range("E" & X).Value)
OrigQty = CLng(.Range("F" & X).Value)
OnHand = CLng(.Range("G" & X).Value)
ParLevel = CLng(.Range("H" & X).Value)
SUPCDescription = CStr(.Range("I" & X).Value)
PackageSize = CStr(.Range("J" & X).Value)
SellUnitOfMeasure = CStr(.Range("K" & X).Value)
BrandName = CStr(.Range("L" & X).Value)
Source = CStr(.Range("M" & X).Value)
Sent = IIf(.Range("N" & X).Value = False, False, True)
End With
sSQL = "INSERT INTO TBLORDERS(OrderNo,SUPCNumber,[Date],Qty," _
& "SUPCDescription,PackageSize,SellUnitOfMeasure,BrandName) " _
& "VALUES(" & OrderNo & "," & SUPCNumber & ",'" & OrdDate & "'," & Qty & ",'" _
& SUPCDescription & "','" & PackageSize & "','" & SellUnitOfMeasure & "','" & BrandName & "');"

oConn.Execute sSQL
Next X

oConn.Close
Set oConn = Nothing

End Sub

tstav
04-06-2008, 10:43 PM
Glad to know it's OK. Nice talking to you, Jim.
Have a nice day,
tstav