[AccessD] Importing from Excel

Couple of other ways avoiding full Excel Application startup

You can also open an Excel Spreadsheet using the JET OLE DB Provider
to read into a Access table, removing the header record

oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=c:\somepath\mySpreadsheet.xls;" & _
           "Extended Properties=""Excel 8.0;HDR=Yes"""
Where "HDR=Yes" means that there is a header row in the cell range
(or named range), so the provider will not include the first row of the
selection into the recordset.  If "HDR=No", then the provider will include
the first row of the cell range (or named ranged) into the recordset.


Sample mbd here
http://support.microsoft.com/default.aspx?scid=kb;en-us;278973

or
 here is some sample VBA code to link a csv text file or optionally a 
xls file from Access

Public Function LinkExternalFileADO(ByVal strTextFileName As String, _
                              ByVal strLinkTable As String, _
                              ByVal strLinkSpecRange As String, _
                              Optional blnXL As Boolean) As Boolean
    'Created by Charlotte Foust
    'drops and relinks the temp table
    'and returns a boolean value for
    'the success of the operation
    'last modified 7/5/2001
    'Sample call:  LinkTextFileADO("MyTable.tab","MyTable","MyTable
Spec")
    '
LinkTextFileADO("MySheet.xls","MySheet","MyRange",True)
   
    On Error GoTo Proc_err
    Dim cat As ADOX.Catalog
    Dim cnn As ADODB.Connection
    Dim errsCnn As ADODB.Errors
    Dim errCurr As ADODB.Error
   
    'initialize the return value
    LinkExternalFileADO = True
   
    'initialize the object variables
    Set cnn = CurrentProject.Connection
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = cnn
    Set errsCnn = cnn.Errors
    errsCnn.Clear
   
    'if the file exists, try to link it
    If strLinkTable <> "" Then
   
      'If no path was included, use the current path
      If InStr(strTextFileName, "\") = 0 Then
     
        strTextFileName = CurrentProject.Path & "\" & strTextFileName
      End If 'InStr(strTextFileName, "\") = 0
     
     'if the file exists then ...
      If Dir(strTextFileName) <> "" Then
        On Error Resume Next
       
        'delete the existing table link
        cat.Tables.Delete strLinkTable
        On Error GoTo Proc_err
       
        'link either a text file or an Excel spreadsheet
        If Not blnXL Then
       
          'create a new link to the text file
          DoCmd.TransferText acLinkDelim, strLinkSpecRange, _
            strLinkTable, strTextFileName
           
        Else 'If Not blnXL
       
          'create a new link to the Excel file
          DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, _
                          strLinkTable, strTextFileName, True,
strLinkSpecRange
        End If 'Not blnXL
       
      Else 'If Dir(strTextFileName) <> ""
     
        'not a valid filename or path
        LinkExternalFileADO = False
      End If 'Dir(strTextFileName) <> ""
    End If
   
Proc_exit:
  'cleanup and exit
  On Error Resume Next
  Set cat = Nothing
  Set errsCnn = Nothing
  Set errCurr = Nothing
  Set cnn = Nothing
  Exit Function
Proc_err:
  If errsCnn.Count > 0 Then
    For Each errCurr In errsCnn
      MsgBox "Error #" & errCurr.Number & "--" & errCurr.Description _
            & vbCrLf & CurrentProject.Name & ".LinkTextFileADO"
    Next errCurr
    errsCnn.Clear
  End If
  If Err <> 0 Then
    MsgBox Err.Number & "--" & Err.Description & vbCr _
            & " in LinkTextFileADO", vbOKOnly
  End If
  LinkExternalFileADO = False
  Resume Proc_exit
End Function
 'LinkExternalFileADO(ByVal strTextFileName As String, _
                              ByVal strLinkTable As String, _
                              ByVal strLinkSpecRange As String, _
                              Optional blnXL As Boolean) As Boolean

ewaldt at gdls.com wrote:

>I wrote the code below, which works really well and I'm very happy with 
>it. This is code for Excel, though. What I need to do is the following:
>
>1. Have the user find the Excel file (I can do this).
>2. Have the code below apply to the Excel file (Don't know how to do this 
>from within Access).
>3. Have Access run the import process on the new worksheet (Not sure how 
>to have it do that specific sheet; can it work on a workbook already in 
>memory without saving the Excel file first?).
>4. Do more processing of the data (I have this set up).
>
>So I really need help with #2 and maybe #3 above. Of course #2 is using 
>the Excel object model, and that has to be taken into consideration.
>
>Any help?  Thanks.
>
>Thomas F. Ewald
>Stryker Mass Properties
>General Dynamics Land Systems
>
>----------------------------------------------------------
>Sub PrepForImport()
>
>' Created 7/26/2007 by ewaldt
>
>Dim intLastRow As Integer
>Dim intCount As Integer
>Dim intNewRow As Integer
>Dim oCell As Object
>
>    Sheets.Add
>    Sheets("Sheet1").Name = "ToImport"
>    Sheets("ToImport").Select
> 
>'Copy only rows where column B = "A"
>    intNewRow = 1
>
>    For Each oCell In Sheets("GDLS-SHC").Range("B:B")
>        If oCell.Formula = "A" Then
>            oCell.EntireRow.Copy
>            ActiveSheet.Paste 
>Destination:=Worksheets("ToImport").Range("A" & intNewRow)
>            intNewRow = intNewRow + 1
>        End If
>    Next oCell
> 
>    For Each oCell In Sheets("GDLS-C").Range("B:B")
>        If oCell.Formula = "A" Then
>            oCell.EntireRow.Copy
>            ActiveSheet.Paste 
>Destination:=Worksheets("ToImport").Range("A" & intNewRow)
>            intNewRow = intNewRow + 1
>        End If
>    Next oCell
> 
>'Check for non-numeric in Pounds and Grams
>    For Each oCell In Sheets("ToImport").Range("C1:D" & intNewRow - 1)
>        If Not IsNumeric(oCell.Formula) Then
>            oCell.Formula = 0
>        End If
>    Next oCell
> 
>End Sub
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada