Public Function OpenExcelAddWorkbook(strFullFileName As String, _
strWorkbookName As String, _
strQueryName As String, _
Optional blnClose As Boolean) As Boolean
On Error GoTo Err_Proc
Public Function OpenExcelAddWorkbook(strFullFileName As String, _
strWorkbookName As String, _
strQueryName As String, _
Optional blnClose As Boolean) As Boolean
On Error GoTo Err_Proc
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
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
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
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, _