Export Access Query to Specific Columns

koolwaters

Active Member
Joined
May 16, 2007
Messages
403
Hi,

I am trying to export an Access query into an Excel template.

The query is exported starting in cell B4.

My code works for the most part but I need to export the query to columns B-K, skip columns L-R (as these contain formulas ) and then export to column S.

My challenge is that i am not sure how to get the last field in my query exported, starting at S4 in the template. The code below is what I am using but it puts the last field of the query in column L but I want it in column S.

Code:
Public Sub ExportReleases()
Dim cnn As ADODB.Connection
Dim MyRecordset As New ADODB.Recordset
Dim MySQL As String, stPath As String
Dim Xl As Object, XlBook As Object, XlSheet As Object
Dim db As DAO.Database
Set cnn = CurrentProject.Connection
Dim myStartDate As Date, myEndDate As Date
On Error Resume Next

myStartDate = Me.StartDate
myEndDate = Me.EndDate

MyRecordset.ActiveConnection = cnn

    If Not IsNothing(Me.StartDate) Then
        If Not IsDate(Me.StartDate) Then
            MsgBox "You must enter a valid 'From' date.", vbExclamation, gstrAppTitle
            Me.StartDate.SetFocus
            Exit Sub
        End If
    End If
    If Not IsNothing(Me.EndDate) Then
        If Not IsDate(Me.EndDate) Then
            MsgBox "You must enter a valid 'To' date.", vbExclamation, gstrAppTitle
            Me.EndDate.SetFocus
            Exit Sub
        End If

        If Not IsNothing(Me.StartDate) Then
            If Me.EndDate < Me.StartDate Then
                MsgBox "'To' Date must not be earlier than 'From' Date.", _
                    vbExclamation, gstrAppTitle
                Me.EndDate.SetFocus
                Exit Sub
            End If
        End If
    End If

    DoCmd.SetWarnings False
        MySQL = "SELECT * FROM qrptBOS " & _
        "WHERE BOSReceived between #" & myStartDate & "# and #" & myEndDate & "#;"
    MyRecordset.Open MySQL

stPath = GetFEPath & "\Excel Reports\BOS.xltx"

Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(stPath)

Xl.Visible = True
XlBook.Windows(1).Visible = True

Set XlSheet = XlBook.Worksheets("BOS")
XlSheet.Range("B4").CopyFromRecordset MyRecordset
XlSheet.Range("C1") = myEndDate

MyRecordset.Close
MyRecordset.Close

Set cnn = Nothing
Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing
DoCmd.SetWarnings True
End Sub

Additionally, I would like to retain the formatting in the template and save the template as an .xlsx workbook using the month portion of the date in cell C1 but I was playing around with the code to no avail.

Thanks for your feedback.
 
Last edited:

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

stumac

Active Member
Joined
Jul 16, 2010
Messages
471
A couple of ways I could think of handling this.

1 - pull your data into a blank sheet in excel and have a formatted sheet reference the data sheet.... This is how I tend to handle it as the export 'Transfer SpreadSheeet' doesn't require a reference to the Excel object model.

2 - change your recordset to only include the fields you want at the first range then repeat with an updated recordset only including the fields you want at the second. You must ensure that you sort your data in this scenario using a unique reference (it doesn't need to be in the output).
 

Russell Hauf

MrExcel MVP
Joined
Feb 10, 2002
Messages
1,611
I would suggest that you export this data to say a hidden sheet in your workbook, and then lookup these values using formulas in the BOS sheet. Or you might consider moving your formulas around so that you don't have to move one column over.
That said, that are (fairly easy) ways that you can loop through the recordset to achieve what you want.
More info needed for your date, but if there is a date in cell C1 then you could do something like
Code:
Format(Range("C1"),"MMM")
to get a 3-character month abbreviation.

Have fun!
 

koolwaters

Active Member
Joined
May 16, 2007
Messages
403
Thanks for the responses.

I have got it to work by creating a second recordset using just the one column that is needed and copying it to S4.

For the formatting, I created a macro in Excel and called the macro after the records are copied to the template.

Code:
Public Sub ExportReleases()
Dim cnn As ADODB.Connection
Dim MyRecordset As New ADODB.Recordset, MyRecordset2 As New ADODB.Recordset
Dim MySQL As String, MySQL2 As String, stPath As String, stPath2 As String, stTitle As String, stSaveName As String, mcrCopyFirstRowFormat As String
Dim Xl As Object, XlBook As Object, XlSheet As Object
Dim db As DAO.Database
Set cnn = CurrentProject.Connection
Dim myStartDate As Date, myEndDate As Date
On Error Resume Next

myStartDate = Me.StartDate
myEndDate = Me.EndDate

MyRecordset.ActiveConnection = cnn
MyRecordset2.ActiveConnection = cnn

    If Not IsNothing(Me.StartDate) Then
        If Not IsDate(Me.StartDate) Then
            MsgBox "You must enter a valid 'From' date.", vbExclamation, gstrAppTitle
            Me.StartDate.SetFocus
            Exit Sub
        End If
    End If
    If Not IsNothing(Me.EndDate) Then
        If Not IsDate(Me.EndDate) Then
            MsgBox "You must enter a valid 'To' date.", vbExclamation, gstrAppTitle
            Me.EndDate.SetFocus
            Exit Sub
        End If

        If Not IsNothing(Me.StartDate) Then
            If Me.EndDate < Me.StartDate Then
                MsgBox "'To' Date must not be earlier than 'From' Date.", _
                    vbExclamation, gstrAppTitle
                Me.EndDate.SetFocus
                Exit Sub
            End If
        End If
    End If

    DoCmd.SetWarnings False
        MySQL = "SELECT * FROM qrptBOS " & _
        "WHERE BOSReceived between #" & myStartDate & "# and #" & myEndDate & "#;"
    MyRecordset.Open MySQL

stPath = GetFEPath & "\Excel Reports\BOS.xlsm"
stPath2 = GetFEPath & "Excel Reports"
mcrCopyFirstRowFormat = "BOS.xlsm'!CopyFirstRowFormat.CopyFirstRowFormat"

Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(stPath)

Xl.Visible = True
XlBook.Windows(1).Visible = True

Set XlSheet = XlBook.Worksheets("BOS")
XlSheet.Range("B4").CopyFromRecordset MyRecordset

    DoCmd.SetWarnings False
        MySQL2 = "SELECT ReleaseAmount FROM qrptBOS2 " & _
        "WHERE BOSReceived between #" & myStartDate & "# and #" & myEndDate & "#;"
    MyRecordset2.Open MySQL2

Set XlSheet = XlBook.Worksheets("BOS")
XlSheet.Range("S4").CopyFromRecordset MyRecordset2
XlSheet.Range("C1") = myEndDate

Xl.Run mcrCopyFirstRowFormat

stTitle = Format(myEndDate, "mmmm") & " BOS"
stSaveName = stPath2 & "\" & stTitle & ".xlsm"
XlBook.SaveAs fileName:=stSaveName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

MyRecordset.Close
MyRecordset.Close
MyRecordset2.Close
MyRecordset2.Close

Set cnn = Nothing
Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing
DoCmd.SetWarnings True

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,126,896
Messages
5,621,497
Members
415,844
Latest member
Reda Fouad Ramzy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top