Data transfer from access to excel automated way

[mikeprof99]

Ok guys this is what I need to do. I have an Access application that does lot of processing and enhrichment of some data. At the end of my process it will derive some values that I will need to transfer it to Excel Template I have designed. Below is the layout of Excel File



UniqueID Region1 Region2 Region3 Region4
1001 (Loc CellD12) Loc cell E12 Loc Cell F12 Loc Cell G12
1002 (Loc CellD13) Loc Cell E13
1003
1004
1006


Note - The Loc Cell D12 means the actual cell D12 where I will have to populate the values.

My Access Table (tblRegionSalesCalc) is Designed as

UniqueID CellLoc Values
1001 D12 2365
1001 E12 9892
1001 F12 4523
1002 E13 2325

The name of my Excel workbook is SalesByIDRegion and the name of my worksheet is RegionalSales

How do I go about writing a VBA code that at a click of a button will take the data from the Access table (tblRegionSalesCalc) open the Excel workbook SalesByIDRegion and use the worksheet RegionalSales and take the CellLoc and its Values from the Access table and put the associated values in the respective cell. Any help you can provide will be greatly appreciated. So the value of cell D12 in the table is 2365, I want the same value to be populated in the cell D12.

I found a code on the internet written by Ashish and is pasted below. Now I need some help in modifying the code to point it the destination cell as specified in my Access table, grab the data from the table and use the workbook and worksheet I have.


Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "SomeSheet"
Const conWKB_NAME = "C:\Documents and Settings\thakkami\Desktop\book1.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("tblExcelValuesTransport", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing

 

[namliam]

Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "SomeSheet"
Const conWKB_NAME = "C:\Documents and Settings\thakkami\Desktop\book1.xls"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  Set rs = db.OpenRecordset("tblExcelValuesTransport", dbOpenSnapshot)
  With objXL
    .Visible = True
    Set objWkb = .Workbooks.Open(conWKB_NAME)
    On Error Resume Next
    Set objSht = objWkb.Worksheets(conSHT_NAME)
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = conSHT_NAME
    End If
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
      .Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
          intLastCol)).ClearContents
      .Range(.Cells(1, 1), _
        .Cells(1, rs.Fields.Count)).Font.Bold = True
      .Range("A2").CopyFromRecordset rs
    End With
  End With
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rs = Nothing
  Set db = Nothing

.cells(1,1) means: A1
.cells(row, column)

This should help you along....

Oh and please use code wraps when you post code [ code ] actual code here [ /code ]
With the [] part offcourse then without the spaces (or use the # button in the post tool bar

Oh Oh, and welcome to the forum

 

[mikeprof99]

Hi Thanks for your reply. My apologies about the code, I copied from Notepad and it did not indent here. Still learning the tricks here.

How do I reference it to the table the cell location and tell the code to take the corresponding values and copy it to the destination cell in Excel?

 

[mikeprof99]

Ok...I have been able to call the file and worksheet I need to use but I am not able to figure out via code the cell location and its associated values to populate the report. Any help you can provide will be truly appreciated.

Sub sPopulateReport()
Dim strFilter As String
Dim strInputFileName As String
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strFilter = ahtAddFilterItem(strFilter, "all Files (*.*)", "*.*")
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:="Choose Excel file to populate the data..", _
Flags:=ahtOFN_HIDEREADONLY)
If Len(strInputFileName) > 0 Then
' Do something with the selected file
 
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim DB As Database
Dim Rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Schedule 1"
' Const conWKB_NAME = "C:\Documents and Settings\thakkami\Desktop\book1.xls" 'static name
' MsgBox strInputFileName just for debugging
Const conWKB_NAME = "strInputFileName" 'dynamic file selection
Set DB = CurrentDb
Set objXL = New Excel.Application
Set Rs = DB.OpenRecordset("tblExcelValuesTxfr", dbOpenSnapshot)
With objXL
.Visible = True
' Set objWkb = .Workbooks.Open(conWKB_NAME)
Set objWkb = .Workbooks.Open(strInputFileName)
 
On Error Resume Next
' Set objSht = objWkb.Worksheets(conSHT_NAME)
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
' Set objSht = objWkb.Worksheets.Add 'This is to add a new sheet if the conSHT_NAME is not present
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, Rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset Rs
End With
End With
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set Rs = Nothing
Set DB = Nothing
 
 
 
Else
'No file chosen, or user canceled
 
End If
 
 
End Sub

 

[namliam]

.cells(1,1) means: A1
.cells(row, column)

This should help you along....

Try that and see if that helps

 

[mikeprof99]

Hi Namliam,

Thank you for your response. I know that what you are referring it to but I am stuck just this portion of the code.

With objSht
' .Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
' intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, Rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset Rs
End With

As I have mentioned, in my Access tables I do have the cell destination and associated values I want populated in the Excel. My question is how do I code this section where it can see my Access table and say hey the value of cell D12 is 100 in the table so now go to cell D12 and write 100 in it.

 

[namliam]

.cells(1,1) == A1
.Cells(2,1) == A2
.cells(1,2) == B1
.cells(1,4) == D1
or instead of cells you can use the absolute reference in range:
.Range("A1")


You already have your table open (rs) so rs!YourFieldName will return your 100.

 

[DCrake]

Here is a link to a MS aticle on how to copy data from Access to Excel using various methods.