Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA- double entry in DB 2

Status
Not open for further replies.
Ramy27

Ramy27

Technical User
Apr 26, 2005
63
GB
Hi everyone, hope you’re having a great day.
The following code exports an Excel table with Job codes to a database table.
The code works and I’ve tested it. However, I still have a problem, and I’m not sure how to proceed from here. The problem is: I don’t want the program to write an entry twice. For example, if a “JobCode” already exists in the database, I want the old entry deleted in the database and new entry copied. Any suggestions?

(NOTE: SQL_INSERT_StringBuilder is a class somebody created for the purposes of constructing SQL "INSERT" statements)

Private Sub OKbutton_Click()

'On Error GoTo Errorhandler
Dim WorksheetNumber As Integer
Dim wb As Object 'Excel.Workbook
Dim datecomp As DataTypeEnum
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim xSQLbuilder As SQL_INSERT_StringBuilder
Dim TimeRange As Excel.Range
Dim JobcodeRange As Excel.Range
Dim i As Long
Dim sqlstr
Dim wbstring As String
Dim DBAddress As String
Dim LoginString As String
Dim workbookNeedsToBeClosed As Boolean
Dim wbtest As Excel.Workbook

DBAddress = "C:\Documents and Settings\Chris\My Documents \Timesheets.mdb"

wbstring = FileNameTextBox.Text

Set conn = New ADODB.Connection


For Each wbtest In Excel.Workbooks
If wbtest.FullName = wbstring Then
Set wb = wbtest
isopen = True
Exit For
End If
Next

If isopen = False Then
Set wb = ExcelProcess.Workbooks.Open(wbstring)
workbookNeedsToBeClosed = True
End If
wb.Activate

LoginString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " _
& DBAddress & ";Jet OLEDB:System database=" _
& ";User Id=" & "admin" _
& "; Password=" & ""

conn.ConnectionString = LoginString
conn.Open

Set JobcodeRange = wb.Sheets("Job codes").Range("JobCodes")

Set xSQLbuilder = New SQL_INSERT_StringBuilder
xSQLbuilder.TableName = "JobCodes"
With xSQLbuilder.ColumnNames
.Add "[Date]"
.Add "Client"
.Add "JobCode"
.Add "Type"
.Add "AorB"
.Add "JobDescription"
.Add "Country"
.Add "ClientContact"
.Add "ShortcutToProposal"
.Add "ProjectLeader"
.Add "JobStatus"
.Add "InvoiceSent"
.Add "PaymentReceived"

End With
For i = 1 To wb.Sheets("Job codes").Range("JobCodes").Rows.Count

With xSQLbuilder
Set .ColumnValues = New Collection
With .ColumnValues
.Add FormatDateForSQL(JobcodeRange.Cells(i, 1).Value, conn)
.Add "'" & CStr(JobcodeRange.Cells(i, 2).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 4).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 5).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 6).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 7).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 8).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 9).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 10).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 11).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 12).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 13).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 14).Value) & "'"

End With
End With
conn.Execute xSQLbuilder.Output
Next i



conn.Close
Set conn = Nothing
If Not xSQLbuilder Is Nothing Then
xSQLbuilder.Delete
Set xSQLbuilder = Nothing
End If


'Tidying up Excel connection
If workbookNeedsToBeClosed Then
wb.Close
End If

Set wb = Nothing
'fMainForm.CloseExcelProcess

'SetMicePointers vbDefault
'Me.Hide
Unload Me
Exit Sub
Errorhandler:
Unload Me

End Sub
 
Sort by date Sort by votes
Insert the values in a temporary table and then launch an update query for Job codes already in the database and an append query for the other.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
It sounds like you got impressed with my code above and thought that I'm an experienced programmer ;)
The truth is, I borrowed the above code from a friend and modified it to suit my purpose.
 
Upvote 0 Downvote
PHV, please could you re-phrase what you're saying in layman terms
 
Upvote 0 Downvote
Hi Ramanesh,

This is standard logic. If a record exists, update it (or delete and then insert), else insert it.

You can either create a cursor up front with all existing job codes or check them one at a time when needed. Alternatively you can put a constraint on the table and trap the insert error. Exactly what is best in your circumstances I can't say.

From your latest post I guess don't know how to code it. Perhaps the easiest is to try to delete an existing record before the update. Do you have other classes as well as SQL_INSERT_StringBuilde?, or do you need SQL. It should be something like this immediately before doing the insert:
[blue][tt] "DELETE * FROM JobCodes WHERE JobCode = '" & CStr(JobcodeRange.Cells(i, 5).Value) & "'"[/tt][/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
Upvote 0 Downvote
I changed my

conn.Execute xSQLbuilder.Output

to

conn.Execute DeleteSQL & " AND " & xSQLbuilder.Output

surely, something is wrong with my code.

(DeleteSQL being the string you just mentioned)
 
Upvote 0 Downvote
And this ?
conn.Execute DeleteSQL
conn.Execute xSQLbuilder.Output

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
When I tried
conn.Execute DeleteSQL
conn.Execute xSQLbuilder.Output

I get the following error msg:
"No value given for one or more parameters
 
Upvote 0 Downvote
What is displayed in the Immediate (debug) Window if you add this line of code ?
Debug.Print DeleteSQL

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
I didn't fully understand what u mean by immediate window, but I typed
Debug.Print DeleteSQL
in the code before

conn.Execute DeleteSQL
conn.Execute xSQLbuilder.Output

It gave the same error msg as before.

Coult it be one of those "'" missing
DeleteSQL = "DELETE * FROM JobCodes WHERE " _
& "JobCodes = '" & CStr(JobcodeRange.Cells(i, 4).Value) & "'"
 
Upvote 0 Downvote
To see the Immediate window, when in VBE (Alt+F11) press Ctrl+G

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
Thanks!!

------[auto_open] <
[SetupFunctionIDs] <
[SetupFunctionIDs] >
[PickPlatform] <
[PickPlatform] >
[VerifyOpen] <
[VerifyOpen] WorkbookName = [ATPVBAEN.XLA]REG
[VerifyOpen] AnalysisPath = C:\program files\microsoft office\Office10\Library\Analysis\ > 2
[RegisterFunctionIDs] <
[RegisterFunctionIDs] >
[auto_open] >
DELETE * FROM JobCodes WHERE JobCodes = '01/KPC/Econ1/05'
DELETE * FROM JobCodes WHERE JobCodes = '01/KPC/Econ1/05'
DELETE * FROM JobCodes WHERE JobCodes = 01/KPC/Econ1/05

------
 
Upvote 0 Downvote
The above is what I got on my Immediate window
 
Upvote 0 Downvote
is it because the table name and the field name are the same?

---------------------------------
Your help is always appreciated, R.
---------------------------------
 
Upvote 0 Downvote
Hi Ramanesh,

The error would appear to be because of missing quotes round [purple]01/KPC/Econ1/05[/purple] on the third line.

But, I don't see how that output could have come from what's been posted. Can you post exactly what you ran to produce it.

-----------------------------------

If your field name and table name are the same on the database then they must be the same in the code.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
Upvote 0 Downvote
I'm really stuck guys, please give me a hand, if you have time. thanks

---------------------------------
Your help is always appreciated, R.
---------------------------------
 
Upvote 0 Downvote
Private Sub OKbutton_Click()

'On Error GoTo Errorhandler
Dim WorksheetNumber As Integer
Dim wb As Object 'Excel.Workbook
Dim datecomp As DataTypeEnum
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim xSQLbuilder As SQL_INSERT_StringBuilder
Dim TimeRange As Excel.Range
Dim JobcodeRange As Excel.Range
Dim i As Long
Dim sqlstr
Dim wbstring As String
Dim DBAddress As String
Dim LoginString As String
Dim workbookNeedsToBeClosed As Boolean
Dim wbtest As Excel.Workbook


DBAddress = "C:\Documents and Settings\Chris\My Documents\Timesheets.mdb"

wbstring = FileNameTextBox.Text

Set conn = New ADODB.Connection

For Each wbtest In Excel.Workbooks
If wbtest.FullName = wbstring Then
Set wb = wbtest
isopen = True
Exit For
End If
Next

If isopen = False Then
Set wb = ExcelProcess.Workbooks.Open(wbstring)
workbookNeedsToBeClosed = True
End If
wb.Activate

LoginString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " _
& DBAddress & ";Jet OLEDB:System database=" _
& ";User Id=" & "admin" _
& "; Password=" & ""

conn.ConnectionString = LoginString
conn.Open

Set JobcodeRange = wb.Sheets("Job codes").Range("JobCodes")

Set xSQLbuilder = New SQL_INSERT_StringBuilder
xSQLbuilder.TableName = "JobCodes"
With xSQLbuilder.ColumnNames
.Add "[Date]"
.Add "Client"
.Add "JobCode"
.Add "Type"
.Add "AorB"
.Add "JobDescription"
.Add "Country"
.Add "ClientContact"
.Add "ShortcutToProposal"
.Add "ProjectLeader"
.Add "JobStatus"
.Add "InvoiceSent"
.Add "PaymentReceived"

End With
For i = 1 To wb.Sheets("Job codes").Range("JobCodes").Rows.Count


DeleteSQL = "DELETE * FROM JobCodes WHERE " _
& "JobCodes = '" & CStr(JobcodeRange.Cells(i, 4).Value) & "'"
Set rs = New ADODB.Recordset
'rs.Open DeleteSQL, conn



With xSQLbuilder
Set .ColumnValues = New Collection
With .ColumnValues
.Add FormatDateForSQL(JobcodeRange.Cells(i, 1).Value, conn)
.Add "'" & CStr(JobcodeRange.Cells(i, 2).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 4).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 5).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 6).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 7).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 8).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 9).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 10).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 11).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 12).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 13).Value) & "'"
.Add "'" & CStr(JobcodeRange.Cells(i, 14).Value) & "'"

End With
End With

conn.Execute DeleteSQL
conn.Execute xSQLbuilder.Output


Next i



conn.Close
Set conn = Nothing
If Not xSQLbuilder Is Nothing Then
xSQLbuilder.Delete
Set xSQLbuilder = Nothing
End If


'Tidying up Excel connection
If workbookNeedsToBeClosed Then
wb.Close
End If

Set rs = Nothing
Set wb = Nothing
'fMainForm.CloseExcelProcess

'SetMicePointers vbDefault
'Me.Hide
Unload Me
Exit Sub
Errorhandler:
'ErrorsFromGUI
Unload Me
'fMainForm.CloseExcelProcess (True)
End Sub

---------------------------------
Your help is always appreciated, R.
---------------------------------
 
Upvote 0 Downvote
Hi Ramanesh,

Firstly, I assume this line:

[blue][tt] .Add "JobCode"[/tt][/blue]

is setting up a field name for your SQL_INSERT_StringBuilder object. So is your field called JobCode or Jobcode[red]s[/red]?]

Secondly, the debug prints you posted could not have come from a single run of that code. Did you run multiple times trying out different things? What result do you get from the code as posted now?

Thirdly, remove the line: [purple][tt]Set rs = New ADODB.Recordset[/tt][/purple]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
Upvote 0 Downvote
Thanks for all your help!! It works!!! Yes, I got the field name all mixed up...sorry.

---------------------------------
Your help is much appreciated, R.
---------------------------------
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
708
combo
combo
xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
519
strongm
strongm
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
1K
hermanlaksko
hermanlaksko
SLW89
  • Locked
  • Question
VBA newbie needs help
Replies
4
Views
649
Andrzejek
Andrzejek
2009luca
  • Question
put value in input box web page
Replies
0
Views
186
2009luca
2009luca

Part and Inventory Search

Sponsor

Back
Top