Okay, I thought from you last post you were linking to an empty sheet because
you said there would only be headers. I guess that means if no one put any
data in the spreadsheet, it would have only headers.
I had a similar problem, so here is my solution. I used automation to open
the spreadsheet, read through it row by row, check for Null in numeric
fields, and load the data in:
************Start Code***************************
Sub LoadAdjustedActuals()
'D Hargis 5/2005
'Loads the AdjustedActuals Excel spreadsheet into the AdjustedActuals table
Dim rstAccess As Recordset 'Recordset for Access table data
Dim varGetFileName As Variant 'Pass to Common Dialog to open workbook
Dim xlApp As Object ' Reference to Microsoft Excel.
Dim blnExcelWasNotRunning As Boolean ' Flag for final release.
Dim xlBook As Object ' Workbook Object
Dim intLastRow As Integer 'Determines number of rows to import
Dim intRowCount As Integer 'Loops through worksheet rows
Dim intColCount As Integer 'Loops through worksheet columns
Dim dblTotCurMoDollarsAccess As Double 'Accumulates total current month
dollars from Access
Dim dblTotCurMoDollarsExcel As Double 'Accumulates total current month
dollars from Excel
Dim strCurrMonth As String 'Used to build file name to open
Dim strCurrYear As String 'Used to build file name to open
Dim strDefaultDir As String 'Pass Directory to search for common dialog
Dim strfilter As String 'Limit common dialog search to excel workbooks
Dim lngFlags As Long 'Hide readonly check box on common dialog
Dim strCurrDollarsRange As String 'Build range for checking sum
'Set Error Handling
On Error GoTo LoadAdjustedActuals_Err
DoCmd.Hourglass True
DoCmd.SetWarnings False
'Set filter to show only Excel spreadsheets
strfilter = ahtAddFilterItem(strfilter, "Excel Files (*.xls)")
'Hides the Read Only Check Box on the Dialog box
lngFlags = ahtOFN_HIDEREADONLY
strCurrMonth = Me.cboPeriod.Column(1)
strCurrYear = Me.txtCurrYear
'Get the File Name To Save
strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
& " Actuals\" & strCurrMonth & "\"
varGetFileName = "Vought Invoice " & strCurrMonth & " " & strCurrYear &
".xls"
varGetFileName = ahtCommonFileOpenSave(ahtOFN_OVERWRITEPROMPT, _
strDefaultDir, "Excel Spreadsheets (*.xls) *.xls", , _
"xls", varGetFileName, "Import Adjusted Actuals", , True)
Me.Repaint
If varGetFileName = "" Then 'User Clicked CANCEL
GoTo LoadAdjustedActuals_Exit
End If
'Open the Table
CurrentDb.Execute "DELETE * FROM AdjustedActuals"
Set rstAccess = CurrentDb.OpenRecordset("AdjustedActuals")
'Open Excel
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlBook.Worksheets("Actuals_res_export").Activate
ActiveSheet.Range("F3").Select
Selection.End(xlDown).Select
intLastRow = Selection.Row
If intLastRow = 0 Then
MsgBox "No Data to Import" & vbNewLine & "Spreadsheet may be open by
another user", _
vbExclamation + vbOKOnly, "Import Adjusted Actuals"
GoTo LoadAdjustedActuals_Exit
End If
'Start the Loop
For intRowCount = 3 To intLastRow
rstAccess.AddNew
For intColCount = 6 To 42
rstAccess.Fields(intColCount - 6) = _
IIf(intColCount < 26, ActiveSheet.Cells(intRowCount,
intColCount), _
Nz(ActiveSheet.Cells(intRowCount, intColCount), 0))
Next intColCount
rstAccess.Update
Next intRowCount
Me.txtAccessDollars = DSum("[CURRENT MO $'s]", "AdjustedActuals")
Me.txtAccessRows = rstAccess.RecordCount
strCurrDollarsRange = "AP3:AP" & CStr(intLastRow)
Me.txtXlDollars =
xlApp.WorksheetFunction.Sum(ActiveSheet.Range(strCurrDollarsRange))
Me.txtXlRows = intLastRow - 2
MsgBox "Import Complete", vbExclamation + vbOKOnly, "Import Adjusted
Actuals"
LoadAdjustedActuals_Exit:
'Close files and delete link to spreadsheet
On Error Resume Next
xlBook.Close
Set xlBook = Nothing
'If we createed a new instance of Excel
If blnExcelWasNotRunning = True Then
xlApp.Application.Quit
End If
Set xlApp = Nothing
rstAccess.Close
Set rstAccess = Nothing
DoCmd.Hourglass False
Exit Sub
LoadAdjustedActuals_Err:
If Err = 462 Then
MsgBox "Lost Connection with Excel Spreadsheet" & vbNewLine & _
"Close and Re-Open Access", vbExclamation + vbOKOnly,
"ImportAdjusted Actuals"
Else
MsgBox Error$
End If
Resume LoadAdjustedActuals_Exit
End Sub
***************End Code*****************