Re: [Access VBA Central] Excel to Access 2003

Mon, 01 May 2006 02:42:02 -0700

You write:
>perhaps there is a minor problem with your script that we as a
>group can help you debug.  Can you post it?

With pleasure.  This is the script:

Option Compare Database
Option Explicit

Sub LoopThroughThem()
  Dim xla As Excel.Application
  Dim xlWb As Excel.Workbook
  Dim xlWS As Excel.Worksheet
  Dim dlg As FileDialog
  '
  Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
  With dlg
    .AllowMultiSelect = False
    .Title = "Select Folder"
    .ButtonName = "Go!"
    .Title = "Please select the folder containing the XLS file..."
  End With
  '
  If dlg.Show() = True Then ' did they select anything
    Set xla = New Excel.Application ' only needs to be done once in
each macro
    xla.Visible = True      ' Excel will remain invisible without
this line

    Dim iFolder As Variant, iFile As String, FileCounter As Long
    For Each iFolder In dlg.SelectedItems     ' loop through each
folder they selected, and import all XLS files in each folder
      iFile = Dir(iFolder & "\*.xls")
      Do Until iFile = ""
        FileCounter = FileCounter + 1
       
        ' open the workbook
        Set xlWb = xla.Workbooks.Open(Filename:=iFolder & iFile,
ReadOnly:=True)
       
        'Set xlWS = xlWb.Sheets(1)   ' select the first sheet
        Set xlWS = xlWb.ActiveSheet   ' select the sheet that was
open when workbook was last saved
       
        ' now import it into Access
        Import_XLS xlWS
       
        ' close it, and move on
        Set xlWS = Nothing
        xlWb.Close SaveChanges:=False
        '
        iFile = Dir ' now find the next matching file
      Loop
    Next
    '
    ' now close Excel
    xla.Quit
    Set xla = Nothing
    '
    MsgBox "All done -- " & FileCounter & " file(s) imported.", _
      vbInformation + vbOKOnly, "Complete"
  End If
End Sub

Sub Import_XLS(ByRef xlWS As Excel.Worksheet)
  Dim cn As ADODB.Connection, RS As ADODB.Recordset

  Set cn = CurrentProject.Connection ' set it to THIS Access database
  Set RS = New ADODB.Recordset
  RS.Open "PreliminarySites", cn, adOpenDynamic, adLockOptimistic,
adCmdTableDirect

  RS.AddNew ' tell Access you're adding a new record

  ' Pull cell contens off of the sheet, and add them to the record.
  ' the cells are referenced in ROW , COL format. So cell G4 is
(7,3) (row 7, col 3)
  RS.Fields("DateSubmitted").Value = xlWS.Cells(4, 2).Value
  RS.Fields("SiteAcquisitionFirm").Value = xlWS.Cells(6, 2).Value
  RS.Fields("SiteAcqSpecialist").Value = xlWS.Cells(8, 2).Value
  RS.Fields("RF_Engineer").Value = xlWS.Cells(10, 2).Value
  RS.Fields("SiteID").Value = xlWS.Cells(12, 2).Value
  RS.Fields("Candidate").Value = xlWS.Cells(14, 2).Value
  ' and so on...
  '  just create more fields in the Access table, and add the
relevant source lines here, and voila

  RS.Update ' tell Access to save the record

  RS.Close
  Set RS = Nothing
  Set cn = Nothing
  Exit Sub
End Sub










SPONSORED LINKS
Microsoft access database Database development software Microsoft access development
Database management software Inventory database software Membership database software

YAHOO! GROUPS LINKS



Reply via email to