S
sahilkaushik
Hi, I have a database in MS Access.
There is a field called "CA No", and another "Total Charges" in my database
and also in excel.
CA No is a unique value to each record. I want that I should be able to
update every record with its "Total Charges" from the excel file (which comes
every month)
Note that updating the record does not mean over writing the record's
current "Total Charges". Another record should be created having the same
values in the fields as the current one except for the "Total Utility
Charges" which should be the one from the excel file.
I was given the code below to make this work, but as of now its not working
fine.
I placed the code below in a module and created a button and in its build
event called it:
Private Sub Command280_Click()
UpdateCharges "C:\Documents and Settings\Desktop\SP_BTS_Dec08",
"cons_summary_20081231_starhubl"
End Sub
Now when I click on the command button, the excel file opens up, the
computer halts for a second. But then when i go back to my database and
check, no new records are created and the total charges are not updated.
Please help
below is my code:
Option Compare Database
Option Explicit
Sub UpdateCharges(xlPath As String, wsName As String)
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim rsData As New ADODB.Recordset
Dim i As Long
Dim fCollection As New Collection
Dim fld As ADODB.Field
Dim tblName As String
tblName = "PB Listing" ' Replace this with the name of your table
On Error Resume Next
' Try get a handle to a pre-existing copy of Excel
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ' Excel not open
Set xlApp = New Excel.Application
xlApp.Visible = True
End If
Set xlWb = xlApp.Workbooks.Open(xlPath, , True) ' open the workbook
Set xlWs = xlWb.Worksheets(wsName) ' get the correct worksheet
rsData.Open tblName, CurrentProject.Connection, adOpenKeyset ' open our table
For i = 1 To xlWs.UsedRange.Rows.Count
rsData.MoveFirst
rsData.Find "[CA No] = " & xlWs.Cells(i, 1).Value
For Each fld In rsData.Fields ' keep track of current field values
fCollection.Add fld.Value, fld.Name
Next
rsData.AddNew ' create our new record
For Each fld In rsData.Fields
fld.Value = fCollection(fld.Name)
Next
' reset our collection
Set fCollection = Nothing
Set fCollection = New Collection
rsData.Fields("Total Charges").Value = xlWs.Cells(i, 2).Value ' put in
the new
value
rsData.Update
Next
End Sub
There is a field called "CA No", and another "Total Charges" in my database
and also in excel.
CA No is a unique value to each record. I want that I should be able to
update every record with its "Total Charges" from the excel file (which comes
every month)
Note that updating the record does not mean over writing the record's
current "Total Charges". Another record should be created having the same
values in the fields as the current one except for the "Total Utility
Charges" which should be the one from the excel file.
I was given the code below to make this work, but as of now its not working
fine.
I placed the code below in a module and created a button and in its build
event called it:
Private Sub Command280_Click()
UpdateCharges "C:\Documents and Settings\Desktop\SP_BTS_Dec08",
"cons_summary_20081231_starhubl"
End Sub
Now when I click on the command button, the excel file opens up, the
computer halts for a second. But then when i go back to my database and
check, no new records are created and the total charges are not updated.
Please help
below is my code:
Option Compare Database
Option Explicit
Sub UpdateCharges(xlPath As String, wsName As String)
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim rsData As New ADODB.Recordset
Dim i As Long
Dim fCollection As New Collection
Dim fld As ADODB.Field
Dim tblName As String
tblName = "PB Listing" ' Replace this with the name of your table
On Error Resume Next
' Try get a handle to a pre-existing copy of Excel
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ' Excel not open
Set xlApp = New Excel.Application
xlApp.Visible = True
End If
Set xlWb = xlApp.Workbooks.Open(xlPath, , True) ' open the workbook
Set xlWs = xlWb.Worksheets(wsName) ' get the correct worksheet
rsData.Open tblName, CurrentProject.Connection, adOpenKeyset ' open our table
For i = 1 To xlWs.UsedRange.Rows.Count
rsData.MoveFirst
rsData.Find "[CA No] = " & xlWs.Cells(i, 1).Value
For Each fld In rsData.Fields ' keep track of current field values
fCollection.Add fld.Value, fld.Name
Next
rsData.AddNew ' create our new record
For Each fld In rsData.Fields
fld.Value = fCollection(fld.Name)
Next
' reset our collection
Set fCollection = Nothing
Set fCollection = New Collection
rsData.Fields("Total Charges").Value = xlWs.Cells(i, 2).Value ' put in
the new
value
rsData.Update
Next
End Sub