dkmoreland
Registered User.
- Local time
 - Today, 05:09
 
- Joined
 - Dec 6, 2017
 
- Messages
 - 129
 
[SOLVED] Extracting data from Excel
I am using the code below to extract data from an Excel spreadsheet that is generated by another program. It's all working except for one thing. Please look at the section in red text. I need to make a comma separated list of those bulk ids and put them all in a field in the table. There are not always 3 of them - sometimes there is only 1 and sometimes there are several.
I also need to add together the values in the shot size field for each of these bulk lines. For example, since the attached has 3 lines with a shot size of 200, I need to set the access field value to 600. If there were 7 lines with a shot size of 200, the value would be 1400. Does that make sense?
It works fine if there is a set number of bulk lines but that will not the reality. How can I adapt the code shown below to create a list from an unknown number of cells and to add together the values from another unknown number of cells?
I appreciate any insight you can offer. I wouldn't have gotten this far with this without help from you guys.
Thanks
	
	
	
		
 I am using the code below to extract data from an Excel spreadsheet that is generated by another program. It's all working except for one thing. Please look at the section in red text. I need to make a comma separated list of those bulk ids and put them all in a field in the table. There are not always 3 of them - sometimes there is only 1 and sometimes there are several.
I also need to add together the values in the shot size field for each of these bulk lines. For example, since the attached has 3 lines with a shot size of 200, I need to set the access field value to 600. If there were 7 lines with a shot size of 200, the value would be 1400. Does that make sense?
It works fine if there is a set number of bulk lines but that will not the reality. How can I adapt the code shown below to create a list from an unknown number of cells and to add together the values from another unknown number of cells?
I appreciate any insight you can offer. I wouldn't have gotten this far with this without help from you guys.
Thanks
		Code:
	
	
	Private Sub CmdImport_Click()
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim FileName As String
Dim FirstSeparator As Integer
Dim db As DAO.Database
Dim Td As DAO.TableDef
Dim tdDefaults As DAO.TableDef
Dim rs As DAO.Recordset
Dim rsDefaults As DAO.Recordset
Dim strMsg As String
Dim strSQL As String
Dim strJob As String
Dim strSubJob As String
Dim strPress As String
Dim strDescription As String
Dim strCustomer As String
Dim strTechnology As String
Dim lngOrderPieces As Long
Dim lngLayout As Long
Dim strBulk1 As String
Dim strBulk2 As String
Dim strBulk3 As String
Dim strBulkList As String
Dim lngShot1 As Long
Dim lngShot2 As Long
Dim lngShot3 As Long
Dim lngShotSum As Long
On Error GoTo ErrProc
    Set db = CurrentDb()
    StrImportFile = Me.TextImport
        
    If Me.TextImport = "" Then
        Exit Sub
        MsgBox "Please select a file.", vbOKOnly
    End If
        
    Set rs = db.OpenRecordset("Job Info")
        
    'open spreadsheet (Input Sheet) page, get data from specific cells
    Set appExcel = Excel.Application
    Set wbk = appExcel.Workbooks.Open(Me.TextImport)
    strJob = Range("'RunTicket'!P3").Value
    strSubJob = Range("'RunTicket'!P4").Value
    
    If IsEmpty(Range("'RunTicket'!P5").Value) Then
        strPress = "N/A"
    Else
        strPress = Range("'RunTicket'!P5").Value
    End If
      
     
    strDescription = Range("'RunTicket'!E8").Value
    strCustomer = Range("'RunTicket'!H9").Value
    strTechnology = Range("'RunTicket'!H12").Value
    lngOrderPieces = Range("'RunTicket'!E16").Value
    
    If strTechnology = "BeautiSeal®" Then
        lngLayouta = Left(Range("'RunTicket'!P25").Value, 1)
        lngLayoutb = Mid(Range("'RunTicket'!P25").Value, 6, 1)
        lngLayoutProd = lngLayouta * lngLayoutb
        
        [COLOR="Sienna"]If Not IsEmpty(Range("'RunTicket'!B30").Value) Then
            strBulk1 = Range("'RunTicket'!B30").Value
            strBulk2 = Range("'RunTicket'!B31").Value
            strBulk3 = Range("'RunTicket'!B31").Value
            strBulkList = strBulk1 & "," & strBulk2 & "," & strBulk3
            lngShot1 = Val(Range("'RunTicket'!N30").Value)
            lngShot2 = Val(Range("'RunTicket'!N30").Value)
            lngShot3 = Val(Range("'RunTicket'!N30").Value)
            lngShotSum = lngShot1 + lngShot2 + lngShot3
        End If[/COLOR]
    End If
    
    
    'close excel
    wbk.Close (False)   'close without saving changes
    appExcel.Quit
    Set wbk = Nothing
    Set appExcel = Nothing
    
    rs.AddNew
        rs![Job #] = strJob + "-" + strSubJob
        Debug.Print strJob + "-" + strSubJob
        rs![Press] = strPress
        rs![Job Name] = strDescription
        rs![Customer Name] = strCustomer
        rs!Technology = strTechnology
        rs![Order Quantity] = lngOrderPieces
        rs!QC = "IM"
        
        If strTechnology = "BeautiSeal®" Then
            rs![Labels on Repeat] = lngLayoutProd
            rs![FP / Bulk #] = strBulkList
            rs![shot size] = lngShotSum
        End If
        
        
    rs.Update
    
    rs.Close
    MsgBox "File " + StrImportFile + " has been imported", vbOKOnly
    
    DoCmd.Close
    Application.Echo False
    DoCmd.Close
    DoCmd.OpenForm "Job Info Form"
    Application.Echo True
        
    
ExitProc:
    Set db = Nothing
    Exit Sub
ErrProc:
    Select Case Err.Number
        Case 462    'excel not open
            Set appExcel = New Excel.Application
            Resume Next
        Case 3125
            MsgBox "The selected workbook is not the correct format.", vbOKOnly
            Resume ExitProc
        Case 3201
            MsgBox "Job Prefix is not valid.  Please add the new prefix to the prefix list.  Import was cancelled.", vbOKOnly
            Resume ExitProc
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume ExitProc
            Resume Next
    End Select
    
End Sub
	
			
				Last edited: