Exporting to a specific excel spreadsheet, and a specific worksheet/cells

[Big2]

Hi,

I have recently been doing a lot of work on this area. Im able to export to where i want to and run macros through the VBA code inside of Access to edit the spreadsheets. This is ok if your making a new excel workbook/worksheet.

But what im stuck on is exporting to a so called template in excel. I can export to it at the moment but creating a new worksheet, in which i have to then cut and paste the data into the correct worksheets through code and then delete the worksheet that i had been working from (which is annoying because you have to confirm the deletion of this worksheet, which is why i couldnt really do the process this way).

What i want to know is there a specific way of telling the data you are exporting from a table/query/querydef to go into a certain worksheet and into a certain cell. For example; a list of names, i want all the Surnames to go into a worksheet called "Claim_Breakdown" and start from cell "A15" downwards until they have all been exported into the worksheet.

Anyone have any ideas on how i could achieve this? Thanks.

 

[reclusivemonkey]

Have you considered setting up a "template" spreadsheet in excel, which uses excel's importing functions to get this data? Without knowing your whole setup, that to me would seem an easier option. BTW, you can turn off the confirmation of deleting sheets in VBA (Application.DisplayAlerts = False), just remember to turn it back on in the code after you've deleted the sheet. Hope this helps.

 

[Big2]

Cheers knew the alerts command in access but not excel, thanks for that.

Figured it out now, realising that i didnt have to do a acExport from access, all i had to do was open a recordset and also open the excel object(link) and then reference the cells to fields in the recordset, which worked nice.

Here is the code below i used if anyone else needs help in this area. The code is assuming that you have already opened the rsClaimBreakdown recordset above etc.

openexcel is a function call with the WhereTo holding the location string.

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
.MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
.MoveNext
Loop
End With

 

[wypowersmoke]

I need to do this very thing but have never programmed in VB. Could you please explain how to do this step by step for a dummy? Thanks you very much.

 

[Big2]

Ok ill post all the code below including the openexcel function. The only thing i cant paste in is the GetExportDirectory_Excel function call coz it jumps around quite a few functions. But if i were you read up on saving dialog boxes in Access books/VB books/internet etc.


This is in my form code:

Private Sub cmdExport_Click()
On Error GoTo LocalError

Dim WhereTo As String
Dim ProjectID As String
Dim rsClaimBreakDown As DAO.Recordset
Dim NoOfRecords As Integer
Dim NoOfWorksheets As Integer

If IsNull(Me.txtStartDate) Or IsNull(Me.txtEndDate) Then
MsgBox "Cannot continue, data missing from Start/End Date boxes. Please fill out before continuing!", vbOKOnly, "Data Capture Error"
txtStartDate.SetFocus
Exit Sub
End If

WhereTo = GetExportDirectory_Excel 'Open the save to dialog box

If WhereTo = "NoFile" Then Exit Sub

ProjectID = "WS"

DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM TempTbl_WorkstepClaimData")
DoCmd.RunSQL ("INSERT INTO TempTbl_WorkstepClaimData ( ClientSurname, ClientFirstname, ClientNINumber, StartDate, CEHours, EndDate, ReasonForLeaving, ProgressionDate, SustainedProgressionDate, PlanDate) " & _
"SELECT DISTINCTROW tbl_Client.ClientSurname, tbl_Client.ClientFirstname, tbl_Client.ClientNINumber, Tbl_Projects.StartDate, Tbl_CurrentEmployers.CEHours, Tbl_Projects.EndDate, Tbl_CurrentEmployers.ReasonForLeaving, Tbl_CurrentEmployers.ProgressionDate, Tbl_CurrentEmployers.SustainedProgressionDate, Tbl_DevPlan.PlanDate " & _
"FROM ((Tbl_Projects INNER JOIN tbl_Client ON Tbl_Projects.ClientID = tbl_Client.ClientID) LEFT JOIN Tbl_CurrentEmployers ON tbl_Client.ClientID = Tbl_CurrentEmployers.ClientID) LEFT JOIN Tbl_DevPlan ON tbl_Client.ClientID = Tbl_DevPlan.ClientID " & _
"WHERE (((Tbl_Projects.ProjectRef)='" & ProjectID & "'));")
DoCmd.SetWarnings True

Set rsClaimBreakDown = CurrentDb.OpenRecordset("TempTbl_WorkstepClaimData")

With rsClaimBreakDown
.MoveLast
NoOfRecords = rsClaimBreakDown.RecordCount
.MoveFirst
End With


'======================================================
'Insert the data from the temptable to the excel sheet
'======================================================

Dim CellRef As Integer
Dim NoOfLoops As Integer

openexcel (WhereTo) 'Gets the location of the template
xl.UserControl = False 'Doesnt allow user any control whilst we run our update
xl.Worksheets(2).Select 'Selects the claim breakdown sheet

'This section inserts the correct number of rows into the body of the spreadsheet
NoOfLoops = NoOfRecords - 1
Do Until NoOfLoops = 0
xl.Rows("16:16").Select
xl.Selection.Insert Shift:=xlDown
xl.Rows("15:15").Select
xl.Selection.Copy 'need to copy the forumlas too, so cant just insert new rows
xl.Rows("16:16").Select
xl.ActiveSheet.Paste
xl.Application.CutCopyMode = False 'takes the flashing cell thing away
NoOfLoops = NoOfLoops - 1
Loop

'Insert the dates
xl.Range("C8").Value = Forms![Frm_Workstep]!txtStartDate
xl.Range("B10").Value = Forms![Frm_Workstep]!txtWeeks
xl.Range("E8").Value = Forms![Frm_Workstep]!txtEndDate

'This Loop section inserts the Data
CellRef = 15 'Starts at 15 because that is the start of the area i want to insert into
NoOfLoops = NoOfRecords
With rsClaimBreakDown
.MoveFirst
Do Until NoOfLoops = 0
xl.Range("A" & CellRef & "").Value = rsClaimBreakDown![ClientSurname]
xl.Range("B" & CellRef & "").Value = rsClaimBreakDown![ClientFirstName]
xl.Range("C" & CellRef & "").Value = rsClaimBreakDown![ClientNINumber]
xl.Range("E" & CellRef & "").Value = rsClaimBreakDown![StartDate]
xl.Range("F" & CellRef & "").Value = rsClaimBreakDown![CEHours]
xl.Range("H" & CellRef & "").Value = rsClaimBreakDown![EndDate]
xl.Range("I" & CellRef & "").Value = rsClaimBreakDown![ReasonForLeaving]
xl.Range("S" & CellRef & "").Value = rsClaimBreakDown![ProgressionDate]
xl.Range("T" & CellRef & "").Value = rsClaimBreakDown![SustainedProgressionDate]
xl.Range("Q" & CellRef & "").Value = rsClaimBreakDown![PlanDate]
CellRef = CellRef + 1
NoOfLoops = NoOfLoops - 1
.MoveNext
Loop
End With

xl.UserControl = True 'Give control back to the user
rsClaimBreakDown.CLOSE

MsgBox "Export to Claim Form completed successfully!", vbOKOnly, "Export Completed"
DoCmd.CLOSE A_FORM, "Frm_Workstep"
xl.Visible = True

LocalExit:
Set xl = Nothing
Set rsClaimBreakDown = Nothing
Exit Sub

LocalError:
MsgBox Err.Number & vbCr & vbCr & Err.Description
Resume LocalExit

End Sub

Openexcel Function:

Option Compare Database
Option Explicit

Public xl As Object 'This is how you will refer to the object once it is open

Function openexcel(strLocation)

Set xl = CreateObject("Excel.Application")

xl.Visible = False 'Makes the spreasheet visible. False will let you open
'it behind the scenes

xl.Workbooks.Open strLocation
'xl.Workbooks.Add 'Will Create a new workbook
End Function

Hope this helps you a little more.