test

[emelem]

Public Function OpenExcelAddWorkbook(strFullFileName As String, _
strWorkbookName As String, _
strQueryName As String, _
Optional blnClose As Boolean) As Boolean
On Error GoTo Err_Proc

[emelem]

If Len(strFullFileName) = 0 Then
MsgBox "Missing filename.", vbCritical + vbOKOnly, "Error"
Exit Function
End If

If Len(strWorkbookName) = 0 Then
MsgBox "Missing sheet name.", vbCritical + vbOKOnly, "Error"
Exit Function
End If

If Len(strQueryName) = 0 Then
MsgBox "Missing query name or SQL string.", vbCritical + vbOKOnly, "Error"
Exit Function
End If

[emelem]

Dim objApp As Object
Dim intSR As Integer
Dim dbs As DAO.Database
Dim rsRecords As DAO.Recordset
Dim strMsg As String
Dim lngMaxCol As Long
Dim lngMaxRow As Long
Dim i As Long
Dim strHeading As String
Dim blnWorksheetExists As Boolean
Dim blnSpreadsheetExists As Boolean

Set dbs = CurrentDb

Set rsRecords = dbs.OpenRecordset(strQueryName)

If rsRecords.EOF And rsRecords.BOF Then
MsgBox "Query or SQL returned no records.", vbCritical + vbOKOnly, "Error"
Exit Function
End If

[emelem]

Set objApp = CreateObject("Excel.Application")
objApp.UserControl = True

blnSpreadsheetExists = MyFileExists(strFullFileName)

If blnSpreadsheetExists Then
objApp.Workbooks.Open strFullFileName
Else
objApp.Workbooks.Add
End If

objApp.DisplayAlerts = True
objApp.ActiveWorkbook.Worksheets(strWorkbookName).Activate

If blnWorksheetExists = True Then
MsgBox "Workbook " & strWorkbookName & " exists!" & _
vbCrLf & vbCrLf & "Data not changed.", vbInformation + vbOKOnly, "Error"
Exit Function
Else
objApp.ActiveWorkbook.Worksheets.Add.Name = "" & strWorkbookName & ""
End If

With objApp.Worksheets("" & strWorkbookName & "")
lngMaxCol = rsRecords.Fields.Count

If rsRecords.RecordCount > 0 Then
rsRecords.MoveLast
rsRecords.MoveFirst
lngMaxRow = rsRecords.RecordCount

If lngMaxRow > 65536 Then
strMsg = Format(lngMaxRow, "#,##0") & " exceeds the maximum " & _
"of 65,536 rows that can be " & vbCrLf

If blnSpreadsheetExists Then
strMsg = strMsg & "exported directly...you will have " & _
"to manully export the " & vbCrLf & _
strMsg = strMsg & "into a spreadsheet."
MsgBox strMsg

[emelem]

rsRecords.Close
Set rsRecords = Nothing
Set dbs = Nothing

objApp.DisplayAlerts = False
objApp.Quit
DoCmd.OpenQuery strQueryName, acViewNormal, acReadOnly

MsgBox "Now use the File + Export manual method."
Exit Function

Else

strMsg = strMsg & "exported directly...switching to transfer."
MsgBox strMsg

rsRecords.Close
Set rsRecords = Nothing
Set dbs = Nothing

objApp.DisplayAlerts = False
objApp.Quit

DoCmd.TransferSpreadsheet acExport, _ acSpreadsheetTypeExcel9, _