Export Access Query to Specific Columns

[koolwaters]

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.

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.

 

[stumac]

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).

 

[alansidman]

You may find this link helpful: AccessBlog.net: Export to Excel range: Tips and tricks, news, links, downloads on Microsoft Access

 

[Russell Hauf]

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

Format(Range("C1"),"MMM")

to get a 3-character month abbreviation.

Have fun!

 

[koolwaters]

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.

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