Clear Excel Worksheet Contents Before Transferring Query From Access 2003

[ctswain]

Hi, very much a novice in VBA and I've been trying to write a bit of code that exports multiple queries from my Access database to Excel. This works brilliantly but I'd like to clear the contents of each Excel worksheet (columns A:H) before the data transfer takes place. Can anyone help ?

Code I'm using is....

Private Sub Command4_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
 Dim rst As DAO.Recordset
 Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
 
 blnEXCEL = False
 blnHeaderRow = True
 
 On Error Resume Next
 Set xlx = GetObject(, "Excel.Application")
 If Err.Number <> 0 Then
       Set xlx = CreateObject("Excel.Application")
       blnEXCEL = True
 End If
 Err.Clear
 On Error GoTo 0
 
 xlx.Visible = True
 
Set xlw = xlx.Workbooks.Open("V:\Ops Timing Collection\OO Database\Risk Registers\Solutions Delivery\RR Examplev2.xlsx")
 
Set xls = xlw.Worksheets("Risks")
 
Set xlc = xls.Range("A1") ' this is the first cell into which data go
 
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("q_RiskRegisterOutputRisks", dbOpenDynaset, dbReadOnly)
 
If rst.EOF = False And rst.BOF = False Then
 
      rst.MoveFirst
 
      If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
                   Next lngColumn
             Set xlc = xlc.Offset(1, 0)
       End If
 
 
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
End If
 
Set xls = xlw.Worksheets("Controls")
 
Set xlc = xls.Range("A1") ' this is the first cell into which data go
 
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("q_RiskRegisterOutputControls", dbOpenDynaset, dbReadOnly)
 
If rst.EOF = False And rst.BOF = False Then
 
      rst.MoveFirst
 
      If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
             Next lngColumn
             Set xlc = xlc.Offset(1, 0)
       End If
 
 
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
 
End If
 
Set xls = xlw.Worksheets("Actions")
 
Set xlc = xls.Range("A1") ' this is the first cell into which data go
 
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("q_RiskRegisterOutputActions", dbOpenDynaset, dbReadOnly)
 
If rst.EOF = False And rst.BOF = False Then
 
      rst.MoveFirst
 
      If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
             Next lngColumn
             Set xlc = xlc.Offset(1, 0)
       End If
 
 
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
 
End If
 
Set xls = xlw.Worksheets("Action Updates")
 
Set xlc = xls.Range("A1") ' this is the first cell into which data go
 
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("q_RiskRegisterOutputActionUpdates", dbOpenDynaset, dbReadOnly)
 
If rst.EOF = False And rst.BOF = False Then
 
      rst.MoveFirst
 
      If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
             Next lngColumn
             Set xlc = xlc.Offset(1, 0)
       End If
 
 
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1, 0)
      Loop
 
End If
 
rst.Close
Set rst = Nothing
 
dbs.Close
Set dbs = Nothing
 
 Set xlc = Nothing
 Set xls = Nothing
 xlw.Close True   ' close the EXCEL file and save the new data
 Set xlw = Nothing
 If blnEXCEL = True Then xlx.Quit
 Set xlx = Nothing
End Sub

Thanks,
Craig

[zmbd]

Would you be opposed to simply deleting the worksheet and letting the method insert a clean one?

[ctswain]

Hi, thanks for replying. Unfortunately I've got some embedded formulas in the receiving spreadsheet that I don't want to overwrite.

Thanks

[zmbd]

darn... thought that would be too easy... (^_^)

Here's the basics, try to code it yourself and if you run into issues, post back the altered code and we'll fine tune it... we work on the teach to fish method (^_^), I do promise that we'll get the code right.

I'm going to translate a few things from your code to my outline
xlx = excelapp
xlw = excelfile
xls = excelsheet
xlc = excelrange < we wont need this for our work

Ok, you already have XLX and XLW setup and it sounds as if you have multiple worksheets so:

- set your excelsheet to the correct index, this starts at 1 and goes in the order of creation.
- Columns are a collection under the sheet object, so... select the columns ("A:H") would select your coulmns a thru h.
- Clearing the selection is an application (excelapp) level method
and we only want to "ClearContents" from the selection
- Finally, we can select the Range "A1" in excelsheet or you can simply leave the cursor where it's at on the worksheet.

repeat for each excelsheet in the excelfile


You might also take a look at the insight article on application automation found here: http://bytes.com/topic/access/insigh...ion-automation mainly over Outlook; however, there's some over Excel too.

I'll be tied up for the next hour or two so, give it try and post back your results.

[ctswain]

Morning Dan, many thanks but I really am a novice and not sure where to start. Anyway

So for the worksheet 'Risks' I've changed...

Set xlc = xls.Range("A1") ' this is the first cell into which data go

to

Set xlc = xls.Range("A:S") ' this is the first cell into which data go

How do I add the 'clearcontents' bit.

Again, apologies for the lack of knowledge.

Thanks, Craig

[zmbd]

Totally new to the VBA scene... that's quite OK, we all started there... sort of like walking (^_^)

I'll send you a boiler plate with some tutorials, one covers the basics of VBA and has a few reference links that I hope provide something useful. Check your bytes.com inbox in a little while - Mornings are very busy for me with meetings and follow-ups in the lab.

Assuming that you borrowed the code in the Original Post (OP), I'm going to point out a few places in the code that are key to understanding what we want to do.

>By line 20
it appears that the code has set xlx to be the working excel application object and is making it visible to the end user.
I would have used zexcelapp as the name

>Line 22
This points XLX to the workbook file and then sets the file to be the xlw object. I would have used zexcelfile to indicate that I am working with a stored file and zexcelwb if I was creating a workbook from within code

>Line 24
Now were setting the object xls to be the worksheet of interest (named "Risks") I would have used zexcelsheet

From OP, at this point, it appears that you want to clear the data in xls starting in column A and going thru column H.

You are then going to transfer information into xls

>Line 52 sets xls to point to Worksheet "Controls"

Also from OP it sounds like you want to clear the data in this sheet...

>line 81 sets xls to point to Worksheet "Actions" repeat the clear and data xfer

>Line 110 sets xls to point to Worksheet "Actions Updates" repeat the clear and data xfer

Then after that you start cleaning up.

So what I suggest is that between lines 20 and lines 22
insert code to select the worksheets as a group
insert code to select the columns A:H as a group
Delete just the contents of the selected

Normative at bytes.com is that we teach you how to fish so that you can develop you own code; however, the application-automation isn't always well documented so an exception I think is in order- no?

So where to start, you have an outline of code to work with and then we just need to understand what we need to use to work with the sheets group.

Many people get their intro to VBA via Excel and recording a "macro." Of course I hate the usage of "Macro" to describe VBA programing because when you get to Ms Access Macro does not mean the same as VBA.... anyway, here's the Excel version created via the record macro:

Now if you open excel and record a macro that does the above selection and clear you'll get something like:

Sheets(Array("query1", "query2", "query3")).Select
    Sheets("query1").Activate
    Columns("A:H").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("query1").Select

Which we need to translate into the automation code for Access:

zexcelfile.Worksheets(Array("query1", "query2", "query3")).Select
    zexcelfile.Worksheets("query1").Activate
'
'here's the quirk. the remaining steps are application level
'NOT at the worksheet level as one would expect
'
    zexcelapp.Columns("a:h").Select
    zexcelapp.Selection.ClearContents
    zexcelapp.Range("A1").Select
'clear the array selection and select the first worksheet in the workbook. 
    Set zexcelsheet = zexcelfile.Worksheets.Item(1)
    zexcelsheet.Select
'
'and the rest of your code would follow

you need only translate to the xlx and xls and alter the worksheet names as needed.
Take special note of the comment at line 4 in my code!


The code has been tested and works in my ACC2010 test database where in I transferred three queries to a workbook, then selected the information etc...

bol
-Z

[ctswain]

Thanks, much appreciated.

[ctswain]

I'm going on holiday now and won't back until the 2nd of June. Thanks for your help so far, hopefully catch up when I get back. Cheers