Subscript Out Of Range

forms_are_nightmares

Registered User.
Local time
Today, 13:08
Joined
Apr 5, 2010
Messages
71
Hello All,

I'm hoping this is just an easy fix....

I found a thread that helped me put the code together to export my query into Excel. When I click the button, I receive a subscript out of range error. The sheet then opens but nothing has been imported. Any help would be greatly appreciated.

The code for the button:
Private Sub Command0_Click()
Call SendTQ2XLWbSheet("qry_priority_bid_sheet", "sheet1", "C:\bid_sheet.xls")
End Sub

The code for the module:
Public Function SendTQ2XLWbSheet(strTQName As String, strSheetName As String, strFilePath As String)
' 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

' strFilePath is the name and path of the file you want to send this data into.

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler


strPath = "c:\bid_sheet"


Set rst = CurrentDb.OpenRecordset(strTQName)

Set ApXL = CreateObject("Excel.Application")


Set xlWBk = ApXL.Workbooks.Open(strPath)

ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets(bid_sheet)

xlWSh.Range("A1").Select

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

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst

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
ApXL.ActiveSheet.Cells.Select
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
xlWSh.Range("A1").Select

rst.Close

Set rst = Nothing

Exit_SendTQ2XLWbSheet:
Exit Function

err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
End Function
 

Users who are viewing this thread

Back
Top Bottom