Import/append sprdsht into an accss table, using file browser

[ncalcaterra]

Hi, I know there are a lot of posts out there on importing an excel spreadsheet into access, but I can't seem to paste them all together to find something that works. Here's what I have:

table name = tImageLog
primary key of table "tImageLog" = ItemID (data type = number)
form name = fAllInOne
command button on form "fAllInOne" = cmdImportImageLog

The filename and location of the excel spreadsheets can and will be different, which is why I'd like to prompt the user to choose the file to import. I'd like to import the spreadsheets into table "tImageLog". I would like to add/append the data from the spreadsheet into the table. However, I also wonder if it's possible to prompt the user to decide if they would like to add to OR delete pre-existing records, before the data is uploaded into the table.

I would greatly appreciate any and all help - thank you very much for your time!

 

[NXMold]

I do this in my database for importing a BOM. I'm always appending and the source xls file is always different.

In my case, there is a lot of variation so I import into a temporary table first and allow the user to review and check the data before commiting it to the live table using SQL.

This is the code behind my button:

Private Sub btnBrowse_Click()
Dim varFileName, varPath, tmpdate, tmpdate2, selectfile, strFilter, StartDir, strDialogTitle As String
Dim lngFlags As Long
Dim fso
  
  strFilter = "Excel Spreadsheet (*.xls)" & vbNullChar & "*.xls" & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
  lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
  
  StartDir = Environ("USERPROFILE") & "\Desktop\"
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.folderexists(StartDir) = False Then StartDir = "C:\"
  Set fso = Nothing

  strDialogTitle = "Please choose BOM file to import"
  selectfile = tsGetFileFromUser(fOpenFile:=False, strFilter:=strFilter, rlngflags:=lngFlags, strDialogTitle:=strDialogTitle, strInitialDir:=StartDir)
  If IsNull(selectfile) Then MsgBox ("User canceled file select"): Exit Sub
  
  txtFileName = selectfile
  txtFileName_AfterUpdate

End Sub

This saves the user selected filename to a text box on the form. Next, the user hits a Preview button importing data into the temp table:

    DoCmd.Hourglass True
    
    DeleteTempRecords 'Delete all records with current job number from persistant temp table
    
    'Establish column map array with same index as rs.fields
    '                   (0)          (1)       (2)       (3)    (4)    (5)        (6)
    strSQL = "SELECT CMEJobNumber, [Detail] AS DET, DesignQty, Name, [Size], Material, Vendor FROM tblTEMP_BOM_XLS WHERE [CMEJobNumber]='" & [txtJobNumber] & "';"
    rs.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    ColIdx(1) = cboDet
    ColIdx(2) = cboQty
    ColIdx(3) = cboName
    ColIdx(4) = cboSize
    ColIdx(5) = cboPN
    ColIdx(6) = cboSupplier
       
    'Open excel
    Dim oExcel, oBook, oSheet As Object
    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Open(txtFileName)
    Set oSheet = oBook.Worksheets(1)
    
    'Begin input
    For RowIdx = txtStartRow To txtEndRow
        If oSheet.rows(RowIdx).Hidden = False Then 'skips hidden rows
            rs.AddNew
            rs.Fields(0) = txtJobNumber
            RowLen = 0
            For intI = 1 To 6
                 If ColIdx(intI) = "-" And intI = 1 Then
                    rs.Fields(1) = autoDet
                    autoDet = autoDet + 1
                 Else
                    CellIdx = ColIdx(intI) & RowIdx
                    SheetVar = oSheet.range(CellIdx).Value
                    If btnSZleft.Visible = True And intI = 4 Then
                            'Combine four fields to create size
                            StrSize = ""
                            
                            CellIdx = cboSize & RowIdx
                            SheetVar = oSheet.range(CellIdx).Value
                            If Len(SheetVar) > 0 Then StrSize = "Ø" & Round(Val(SheetVar), 3)
                            
                            If Not cboSize2 = "-" Then
                                CellIdx = cboSize2 & RowIdx
                                SheetVar = oSheet.range(CellIdx).Value
                                If Len(SheetVar) > 0 Then
                                    If Len(StrSize) > 1 Then StrSize = StrSize & " x "
                                    StrSize = StrSize & Round(Val(SheetVar), 3)
                                End If
                            End If
                            
                            If Not cboSize3 = "-" Then
                                CellIdx = cboSize3 & RowIdx
                                SheetVar = oSheet.range(CellIdx).Value
                                If Len(SheetVar) > 0 Then StrSize = StrSize & " x " & Round(Val(SheetVar), 3)
                            End If
                            
                            If Not cboSize4 = "-" Then
                                CellIdx = cboSize4 & RowIdx
                                SheetVar = oSheet.range(CellIdx).Value
                                If Len(SheetVar) > 0 Then StrSize = StrSize & " x " & Round(Val(SheetVar), 3)
                            End If
                            
                            'rs.Fields(intI) = StrSize
                            SheetVar = StrSize
                    End If
                    If IsNull(SheetVar) = True Or Len(SheetVar) < 1 Then SheetVar = " " 'SQL Insert fails on null values
                    rs.Fields(intI) = SheetVar
                    RowLen = RowLen + Len(SheetVar)
                 End If
            Next intI
            
            If RowLen < 10 Then
                rs.CancelUpdate 'drops blank rows (detail number is still assigned, but does not show up in final output)
            Else
                If Len(rs.Fields(6)) < 2 Then errSupplier = errSupplier + 1 'count rows with blank supplier (sheetvar = " " if null)
                If Len(rs.Fields(1)) < 1 Then errDet = errDet + 1 'count rows with no detail number
                rs.Update
            End If
        
        End If
    Next RowIdx
    If errSupplier > 0 Then MsgBox "There are " & errSupplier & " rows with no supplier" & vbCrLf & "Enter Supplier Name, 'Steel', or 'Stock' on all lines", vbInformation, "Please Fix Missing Information"
    If errDet > 0 Then MsgBox "There are " & errDet & " rows without a detail number", vbInformation, "Please Fix Missing Information"
    
    'Close/Cleanup
    Set rs = Nothing
    oBook.Close (False) 'do not save
    oExcel.Quit
    DoCmd.Hourglass False

After previewing, the user commits data to the live table:

Private Sub btnFinished_Click()
Dim strSQL As String

'Insert records into permanent table
CurrentDb.Execute "INSERT INTO tblBOM SELECT tblTEMP_BOM_XLS.* FROM tblTEMP_BOM_XLS WHERE [CMEJobNumber]='" & [txtJobNumber] & "';", dbFailOnError

'Delete all records with current job number from persistant temp table
DeleteTempRecords

The file browsing is its own code module that I found on the web (probably on this sites faq's):

'.=========================================================================
'.Browse Files Module
'.Copyright 1999 Tribble Software.  All rights reserved.
'.Phone        : (616) 455-2055
'.E-mail       : carltribble@earthlink.net
'.Downloaded from [URL unfurl="true"]http://www.utteraccess.com/forums/showflat.php?Cat=&Board=48&Number=565763&Zf=f48&Zw=file%20dialog&Zg=0&Zl=b&Main=565763&Search=true&where=&Zu=&Zd=l&Zn=&Zt=8&Zs=a&Zy=#Post565763&Zp=[/URL]
'.=========================================================================
Option Compare Database
Option Explicit

Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
 Optional ByRef rlngflags As Long = 0&, _
 Optional ByVal strInitialDir As String = "", _
 Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
 Optional ByVal lngFilterIndex As Long = 1, _
 Optional ByVal strDefaultExt As String = "", _
 Optional ByVal strFileName As String = "", _
 Optional ByVal strDialogTitle As String = "", _
 Optional ByVal fOpenFile As Boolean = True) As Variant
   
   On Error GoTo tsGetFileFromUser_Err
   Dim tsFN As tsFileName
   Dim strFileTitle As String
   Dim fResult As Boolean

   ' Allocate string space for the returned strings.
   strFileName = Left(strFileName & String(256, 0), 256)
   strFileTitle = String(256, 0)

   ' Set up the data structure before you call the function
   With tsFN
      .lStructSize = Len(tsFN)
      .hwndOwner = Application.hWndAccessApp
      .strFilter = strFilter
      .nFilterIndex = lngFilterIndex
      .strFile = strFileName
      .nMaxFile = Len(strFileName)
      .strFileTitle = strFileTitle
      .nMaxFileTitle = Len(strFileTitle)
      .strTitle = strDialogTitle
      .flags = rlngflags
      .strDefExt = strDefaultExt
      .strInitialDir = strInitialDir
      .hInstance = 0
      .strCustomFilter = String(255, 0)
      .nMaxCustFilter = 255
      .lpfnHook = 0
   End With
   
   ' Call the function in the windows API
   If fOpenFile Then
      fResult = ts_apiGetOpenFileName(tsFN)
   Else
      fResult = ts_apiGetSaveFileName(tsFN)
   End If

   ' If the function call was successful, return the FileName chosen
   ' by the user.  Otherwise return null.  Note, the CancelError property
   ' used by the ActiveX Common Dialog control is not needed.  If the
   ' user presses Cancel, this function will return Null.
   If fResult Then
      rlngflags = tsFN.flags
      tsGetFileFromUser = tsTrimNull(tsFN.strFile)
   Else
      tsGetFileFromUser = Null
   End If

tsGetFileFromUser_End:
   On Error GoTo 0
   Exit Function

tsGetFileFromUser_Err:
   Beep
   MsgBox err.Description, , "Error: " & err.Number _
    & " in function basBrowseFiles.tsGetFileFromUser"
   Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.

Private Function tsTrimNull(ByVal strItem As String) As String
   
   On Error GoTo tsTrimNull_Err
   Dim i As Integer
   
   i = InStr(strItem, vbNullChar)
   If i > 0 Then
       tsTrimNull = Left(strItem, i - 1)
   Else
       tsTrimNull = strItem
   End If
    
tsTrimNull_End:
   On Error GoTo 0
   Exit Function

tsTrimNull_Err:
   Beep
   MsgBox err.Description, , "Error: " & err.Number _
    & " in function basBrowseFiles.tsTrimNull"
   Resume tsTrimNull_End

End Function