PDA

View Full Version : HELP NEEDED! export an excel table to a *.mdb database file using vba



hakan439
12-11-2006, 03:54 AM
does anyone can find a solution to my problem!

I have a mdb database called urunler_stok.mdb (U:\urunler-stok.mdb)
and an excel xls file (irsaliye.xls)

I use %95 the excel file and mdb file is only used to update product informations such as price, stock etc... When I open the excel file, it imports the table from the mdb file to sheet2. the imported table includes product id's, product names, unit prices and stock information.
on sheet1, i have a invoice template. when I enter the product name on sheet1, the product id and unit price automatically filled in the template.
what i am doing right now is, on sheet1 when an order is placed, the table in the sheet2 is updated and the order amount is subtracted from the stock colomn.

NOW, what i need is, i should export the updated table (which is on sheet2) to the mdb file back(which i have imported from at the beginning) with VBA.

After several errors, i finally solved all of this but now, it gives such an error message
"THERE WAS AN ERROR. UPDATE WAS NOT SUCCESFUL".

The original code is written by Ken Puls, but in that code, the records are being added to the table again. i do not want this and i want to re-write the updated table instead of the old one.

files are located in c:\. can anyone help? i can send the two files. many thanks for those of you who can help.

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

Option Explicit
Sub DB_Insert_via_ADOSQL()
'Author : Ken Puls
'Macro purpose: To add record to Access database using ADO and SQL
'NOTE: Reference to Microsoft ActiveX Data Objects Libary required
Dim cnt As New ADODB.Connection, _
rst As New ADODB.Recordset, _
dbPath As String, _
tblName As String, _
rngColHeads As Range, _
rngTblRcds As Range, _
colHead As String, _
rcdDetail As String, _
ch As Integer, _
cl As Integer, _
notNull As Boolean
'Set the string to the path of your database as defined on the worksheet
dbPath = ActiveSheet.Range("G1").Value
tblName = ActiveSheet.Range("G2").Value
Set rngColHeads = ActiveSheet.Range("liste")
Set rngTblRcds = ActiveSheet.Range("new_stok")
'Concatenate a string with the names of the column headings
colHead = " ("
For ch = 1 To rngColHeads.Count
colHead = colHead & rngColHeads.Columns(ch).Value
Select Case ch
Case Is = rngColHeads.Count
colHead = colHead & ")"
Case Else
colHead = colHead & ","
End Select
Next ch
'Open connection to the database
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & dbPath & ";"
'Begin transaction processing
On Error GoTo EndUpdate
cnt.BeginTrans
'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count
'Assume record is completely Null, and open record string for concatenation
notNull = False
rcdDetail = "('"
'Evaluate field in the record
For ch = 1 To rngColHeads.Count
Select Case rngTblRcds.Rows(cl).Columns(ch).Value
'if empty, append value of null to string
Case Is = Empty
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
Case Else
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
End Select
'if not empty, set notNull to true, and append value to string
Case Else
notNull = True
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
Case Else
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
End Select
End Select
Next ch
'If record consists of only Null values, do not insert it to table, otherwise
'insert the record
Select Case notNull
Case Is = True
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt
Case Is = False
'do not insert record
End Select
Next cl
EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cnt.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cnt.CommitTrans
End If
'Close the ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub

mdmackillop
12-11-2006, 01:28 PM
Hi Hakan
Welcome to VBAX
Can you zip and post the files. Use Manage Attachments in the Go Advanced section.
regards
MD

hakan439
12-11-2006, 01:46 PM
ok. basically what i want to do is;

to keep my list in an mdb file, while opening excel file, load the table in the mdb file to excel (into sheet2), update the stock colomn (colomn D in sheet2), and than export this new updated stock colomn to the table in the mdb file. i hope it is not so complicated to understand.

tstom
12-18-2006, 03:02 PM
If you are simply storing backup data and have no need to run queries, here is a routine that backs up and restores ranges to and from a binary file. It is very fast and the bin files are fairly compact. I added a named range for the data in columns a to d. "BackUpRange_1". This could be determined dynamically using several of Excel's built in functions. To test, run Sub ExampleBackUpRange(). This will back up the range referred to by "BackUpRange_1" and will clear the contents of this range. Run Sub ExampleRestoreRange() to see your data restored to the same range.



Option Explicit

'for testing only. remove ClearContents after testing
Sub ExampleBackUpRange()
BackUpRange ThisWorkbook.Path & "\Sayfa2.bin", Names("BackUpRange_1")
Names("BackUpRange_1").RefersToRange.ClearContents
End Sub

Sub ExampleRestoreRange()
RestoreRange ThisWorkbook.Path & "\Sayfa2.bin"
End Sub

Sub BackUpRange(FileFullName As String, Target As Name)
Dim FileHandle As Integer
Dim RngToSave As Variant
Dim NameIndex As String * 17
NameIndex = Target.Name
RngToSave = Target.RefersToRange

FileHandle = FreeFile
Open FileFullName For Binary As #FileHandle
Put #FileHandle, 1, NameIndex
Put #FileHandle, 20, RngToSave
Close #FileHandle
End Sub

Sub RestoreRange(FileFullName As String)
Dim FileHandle As Integer
Dim RngToRestore As Variant
Dim NameIndex As String * 17

FileHandle = FreeFile
Open FileFullName For Binary As #FileHandle
Get #FileHandle, 1, NameIndex
Get #FileHandle, 20, RngToRestore
Close #FileHandle

Names(Trim(NameIndex)).RefersToRange = RngToRestore
End Sub

stanl
12-21-2006, 07:33 AM
Open FileFullName For Binary As #FileHandle
Put #FileHandle, 1, NameIndex
Put #FileHandle, 20, RngToSave
Close #FileHandle

I tried to replicate this in a VbScript/wsc file more as a generic means to backup selecxted ranges. Since VCbScript does not permit writing to Binary Files, I attempted


oS = CreateObject("ADODB.Stream")
oS.Type =1 'Binary
oS.Open
oS.Write RngToSave
...

Which errored out since RngToSave referenced the Object handle rather than the data contents. Do you happen to know what is so special about Put that it makes the distinction? Stan

mdmackillop
01-13-2007, 08:05 AM
Hi Hakan
Are you still needing help with this?