Exporting to specific Excel range

J

jonman03

Registered User.
Local time
Today, 09:43
Joined
Nov 5, 2009
Messages
31
Hello all -

I'm trying to export 1 field from my table ("ID Code") to a specific Excel workbook range (lets say A2:A10). I see you can not specify a range using the TransferSpreadsheet argument when exporting, so what are my other options? Is this possible via VBA?

Thank you for your help!
 
Does all that code go in a module? Then call the module from my form button?
 
jonman03 said:
Does all that code go in a module? Then call the module from my form button?
Click to expand...

Yes, it goes into a standard module (not a form, report or class module).

And if you look you can see where the spot is set for the copyfromrecordset code to put the data in (and there is code for headers which you may want to disable).

You could add another optional input to the function which then has the range to use and then use that.

See if you can get it to work the way you want and if not we can try helping to rewrite it.
 
Yea, I really am struggling to even get the initial coding right.

The data I want to export is in a select query named: "qry_export"
The name of the sheet I want to export to is: "Export"
The excel document is located at: C:\Documents and Settings\Admin\Desktop\testexcel.xls

Can you please help?

Thank you!
 
Okay, replace the function you got from my website with this:
Code: 
Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String, Optional strFilePath As String, Optional strRange As String, Optional blnIncludeHeaders As Boolean)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strRange is where you want the data to start.



    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field

    Dim strPath As String


    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler


    If strFilePath <> "" Then
        strPath = strFilePath
    End If


    Set rst = CurrentDb.OpenRecordset(strTQName)

    Set ApXL = CreateObject("Excel.Application")


    If strPath <> "" Then
        Set xlWBk = ApXL.Workbooks.Open(strPath)
    Else
        Set xlWBk = ApXL.Workbooks.Add
    End If

    ApXL.Visible = True
    If strSheetName <> "" Then
        Set xlWSh = xlWBk.Worksheets(strSheetName)
    Else
        Set xlWSh = xlWBk.Worksheets(1)
    End If

    If strRange <> "" Then
        xlWSh.Range(strRange).Select
    Else
        xlWSh.Range("A1").Select
    End If

    If blnIncludeHeaders Then
        For Each fld In rst.Fields
            ApXL.ActiveCell = fld.Name
            ApXL.ActiveCell.Offset(0, 1).Select
        Next
    End If

    rst.MoveFirst
    If strRange <> "" Then
        xlWSh.Range(strRange).CopyFromRecordset rst
    Else
        xlWSh.Range("A2").CopyFromRecordset rst
    End If


    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select

    rst.Close
    Set rst = Nothing

    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

And then you would call it like this:
Code: 
SendTQ2ExcelSheet "qry_export", "Export", "C:\Documents and Settings\Admin\Desktop\testexcel.xls", "A2", False
 
Hi Bob,

I've tried to use the code as supplied above but get the error message:

Compile Error:

User Defined type not defined.


Do you have any ideas where i'm going wrong?

thanks.

Code: 
Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String, Optional strFilePath As String, Optional strRange As String, Optional blnIncludeHeaders As Boolean)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strRange is where you want the data to start.
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field
    Dim strPath As String

    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler

    If strFilePath <> "" Then
        strPath = strFilePath
    End If

    Set rst = CurrentDb.OpenRecordset(strTQName)
    Set ApXL = CreateObject("Excel.Application")

    If strPath <> "" Then
        Set xlWBk = ApXL.Workbooks.Open(strPath)
    Else
        Set xlWBk = ApXL.Workbooks.Add
    End If
    ApXL.Visible = True
    If strSheetName <> "" Then
        Set xlWSh = xlWBk.Worksheets(strSheetName)
    Else
        Set xlWSh = xlWBk.Worksheets(1)
    End If
    If strRange <> "" Then
        xlWSh.Range(strRange).Select
    Else
        xlWSh.Range("A1").Select
    End If
    If blnIncludeHeaders Then
        For Each fld In rst.Fields
            ApXL.ActiveCell = fld.Name
            ApXL.ActiveCell.Offset(0, 1).Select
        Next
    End If
    rst.MoveFirst
    If strRange <> "" Then
        xlWSh.Range(strRange).CopyFromRecordset rst
    Else
        xlWSh.Range("A2").CopyFromRecordset rst
    End If

    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select
    rst.Close
    Set rst = Nothing
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

and here is the call-up code:

Code: 
SendTQ2ExcelSheet "qry_output", "TestingSheet", "C:\Documents and Settings\FOX7HR5\Desktop\New Microsoft Excel Worksheet.xls", "B26", False


any help would be greatly appreciated. :D
 
You probably need to add reference to the correct library. Look for:

Microsoft Office X.0 Object Library

X - depending on your version.
 
You probably need to add reference to the correct library. Look for:

Microsoft Office X.0 Object Library
Click to expand...

Dosen't the code use late binding? I would guess on missing refrence to DAO.

JR
 
hi,
yep it works exactly as i need it to now - i've made a couple of tweaks so that it changes the range for each different month sleceted but yep it's running smoothly.

thanks for all your help.
 
Hi,

I successfully used the above code, but was curious if/how it could be modified to run two queries and insert them, respectively into two separate sheets in the same workbook?

Any help greatly appreciated.

Thanks
 
Add two new parameters to pass in.
One for a sql string2
One for a strSheetName2

create a loop - to pass in both

for two sheets, that might be the easy way
If it is something like a 12 month report, then using something like a xlWBk.Worksheets(X) where X is a variable in a loop might be worth looking into.


Did not have time to test this, but something like this would be quick for two sql strings. Don't pass in names and the loop will move things to the next tab.
Code: 
Public Function SendTQ2ExcelSheet(strTQName As String, strTQName2 As String, strSheetName As String, strSheetName2 As String, Optional strFilePath As String, Optional strRange As String, Optional blnIncludeHeaders As Boolean)
      ' strTQName is the name of the table or query you want to send to Excel
      ' strSheetName is the name of the sheet you want to send it to
      ' strRange is where you want the data to start.
 
          Dim rst As DAO.Recordset
          Dim ApXL As Object
          Dim xlWBk As Object
          Dim xlWSh As Object
          Dim fld As Field
          Dim strPath As String
          Dim X As Integer ' count loop
          Const xlCenter As Long = -4108
          Const xlBottom As Long = -4107
10        On Error GoTo err_handler
20        If strFilePath <> "" Then
30            strPath = strFilePath
40        End If
50        Set ApXL = CreateObject("Excel.Application")
60        For X = 1 To 2
70        If X = 1 Then
80            strTQName = strTQName
90            strSheetName = strSheetName
100       Else
110           strTQName = strTQName2
120           strSheetName = strSheetName2
130       End If
140           Set rst = CurrentDb.OpenRecordset(strTQName)
150           If strPath <> "" Then
160               Set xlWBk = ApXL.Workbooks.Open(strPath)
170           Else
180               Set xlWBk = ApXL.Workbooks.Add
190           End If
200           ApXL.Visible = True
210           If strSheetName <> "" Then
220               Set xlWSh = xlWBk.Worksheets(strSheetName)
230           Else
240               Set xlWSh = xlWBk.Worksheets(X)
250           End If
260           If strRange <> "" Then
270               xlWSh.Range(strRange).Select
280           Else
290               xlWSh.Range("A1").Select
300           End If
310           If blnIncludeHeaders Then
320               For Each fld In rst.Fields
330                   ApXL.ActiveCell = fld.Name
340                   ApXL.ActiveCell.Offset(0, 1).Select
350               Next
360           End If
370           rst.MoveFirst
380           If strRange <> "" Then
390               xlWSh.Range(strRange).CopyFromRecordset rst
400           Else
410               xlWSh.Range("A2").CopyFromRecordset rst
420           End If
 
430           xlWSh.Range("1:1").Select
              ' This is included to show some of what you can do about formatting.  You can comment out or delete
              ' any of this that you don't want to use in your own export.
440           With ApXL.Selection.Font
450               .Name = "Arial"
460               .Size = 12
470               .Strikethrough = False
480               .Superscript = False
490               .Subscript = False
500               .OutlineFont = False
510               .Shadow = False
520           End With
530           ApXL.Selection.Font.Bold = True
540           With ApXL.Selection
550               .HorizontalAlignment = xlCenter
560               .VerticalAlignment = xlBottom
570               .WrapText = False
580               .Orientation = 0
590               .AddIndent = False
600               .IndentLevel = 0
610               .ShrinkToFit = False
620               .MergeCells = False
630           End With
              ' selects all of the cells
640           ApXL.ActiveSheet.Cells.Select
              ' does the "autofit" for all columns
650           ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
              ' selects the first cell to unselect all cells
660           xlWSh.Range("A1").Select
670           rst.Close
680           Set rst = Nothing
 
690      Next X
 
 
700       Exit Function
err_handler:
710       DoCmd.SetWarnings True
720       MsgBox Err.Description, vbExclamation, Err.Number
730       Exit Function
End Function
 
Last edited:
Rx_ said:
Add two new parameters to pass in.
One for a sql string2
One for a strSheetName2

create a loop - to pass in both

for two sheets, that might be the easy way
Click to expand...

No, not a good idea to add parameters. What if you need 3 for instance one time do you add more parameters? Best to keep it standard.

If you are sending to a workbook that has existing worksheets then you can run that code twice (or however many times you need) by passing in the appropriate values in a loop. You'll just have to modify the code so that it saves the worksheet (which I didn't include in this one) and then closes it so it can be opened to the next worksheet.
 
Your absolutely right.

It is best to plan for expansion.
Very often the the 2nd tab will turn into many tabs.
And if there is an optional user interface for example that ask the user something like "how many months of reports?" number of tabs will be dynamic.

It is much better to design for the long run.

This example should only be used to demonstrate what Excel objects create the Workbook and then the internal worksheet (tabs) objects.

It was useful to turn on the Excel's visible and step through the code to understand the line of code and watch the Excel being created.

It is a great way for beginners to see code in action.
 
boblarson said:
No, not a good idea to add parameters. What if you need 3 for instance one time do you add more parameters? Best to keep it standard.

If you are sending to a workbook that has existing worksheets then you can run that code twice (or however many times you need) by passing in the appropriate values in a loop. You'll just have to modify the code so that it saves the worksheet (which I didn't include in this one) and then closes it so it can be opened to the next worksheet.
Click to expand...

Thanks. This seems like a simple solution but I may not be properly understanding it. I haven't ever put values in a loop.

I added the following code to save and close the workbook after the first export:

Code: 
 'save and close Excel File
    ApXL.Application.DisplayAlerts = False
    ApXL.Application.Save
    ApXL.Application.DisplayAlerts = True
    ApXL.Application.Quit
 
    Set xlWSh = Nothing
    Set xlWkb = Nothing
    Set ApXL = Nothing

And then revised the call as follows:

Code: 
SendTQ2ExcelSheet "qryGeneReport", "Income Leases", "H:\My Documents\Lease Summary - All Markets.xls", "A2", False
    SendTQ2ExcelSheet "qryModifiedLastMonth", "Lease Obligations", "H:\My Documents\Lease Summary - All Markets.xls", "A2", False

When I run it the first sheet populates, the workbook closes and reopens and I get the error:

1004 Select method of Range class failed.

I'm sure I'm missing something obvious (at least obvious to the trained eye!).

Any thoughts?

Thanks
 
You want this instead (and you shouldn't need the DisplayAlerts settings if you use this):
Code: 
 'save and close Excel File
    
    xlWkb.Save
    xlWkb.Close
    ApXL.Application.Quit
 
    Set xlWSh = Nothing
    Set xlWkb = Nothing
    Set ApXL = Nothing

And WHERE exactly did you add that code? Did you add it in the function?
 
Thanks

The Save & Close code is in the Function.

the other code is in the OnClick event of a button on a form.

It seems to matter which was the active sheet when I previously closed the workbook.

If the "Income Leases" was active, it populates that sheet, closes, then fails on the second command.
If "Lease Obligations" was active, I get the same error as stated above and once I hit Ok it then opens a second (Read Only) instance of the workbook and populates "Lease Obligations"
 
Thought it would be more helpful to post the entire call code

Code: 
Private Sub btnGene_Click()
On Error GoTo Err_btnGene_Click
    SendTQ2ExcelSheet "qryGeneReport", "Income Leases", "H:\My Documents\Lease Summary - All Markets.xls", "A2", False
    SendTQ2ExcelSheet "qryModifiedLastMonth", "Lease Obligations", "H:\My Documents\Lease Summary - All Markets.xls", "A2", False
 
Exit_btnGene_Click:
    Exit Sub
Err_btnGene_Click:
    MsgBox Err.Description
    Resume Exit_btnGene_Click
 
End Sub

As I say, I have not used loops before so the concept is new to me. I'm reading an intro article but any pointers would be gratefully received.

Thx
 
You must log in or register to reply here.

Similar threads

N
Solved Export data from Passthrough Query to CSV
2
Replies
20
Views
641
Gasman
Gasman
Gasman
Solved Open Excel workbook, but have WorkBook_Open code run
Replies
19
Views
837
Gasman
Gasman
J
Use VBA to export form data to Excel, but keep getting "We Found a Problem..." when opening the file in Excel
Replies
5
Views
632
June7
June7
oxicottin
Solved Export to Excel error '1004' With time format
Replies
9
Views
900
ebs17
E
A
Solved Exporting Table to Excel by Category
Replies
9
Views
884
abrody
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom