Help Importing Excell data to Access table

[Ifshaanm]

Hi All

I have a VBA function to syncsuppliers as below

Function SyncSuppliers()

On Error GoTo errhandle
Filename = DLookup("SupplierPath", "Setup", "SetupActive = True")
If Filename = "" Then
Exit Function
End If
Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Open(Filename)
Set xlsheet = xlBook.Sheets("Cordell Suppliers")
xlapp.Visible = False

'Supplier Section

Dim SuppID As Variant
Dim SupName() As String
Dim SupplierName As String
Dim SupplierTable As DAO.Recordset
Dim TeleFaxStr() As String
Set xlRange = xlsheet.Range("E11:E1000")
For Each MyCell In xlRange
If (xlsheet.Cells(MyCell.row, 1).value <> "") Then

If xlsheet.Cells(MyCell.row, 5).value = "" Then
SupplierName = Trim(LastSupName) & " (2)"
Else
SupName = Split(xlsheet.Cells(MyCell.row, 5).value, " (")
SupplierName = Trim(SupName(0))
LastSupName = Trim(SupName(0))

End If
SuppID = DLookup("[SupplierID]", "[Approved Suppliers]", "[SupplierName]= '" & SupplierName & "'")

'Supplier already Exists
If Not IsNull(SuppID) Then

Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")

SupplierTable.FindFirst "SupplierID = " & SuppID
If Not SupplierTable.NoMatch Then

SupplierTable.Edit
SupplierTable!SupplierName = SupplierName
SupplierTable!Address = xlsheet.Cells(MyCell.row, 7).value
TeleFaxStr = Split(xlsheet.Cells(MyCell.row, 6).value, "FAX-")
SupplierTable!Telephone = Trim(Right(TeleFaxStr(0), Len(TeleFaxStr(0)) - 4))
SupplierTable!FaxNumber = Trim(TeleFaxStr(1))
SupplierTable!RiskFactor = xlsheet.Cells(MyCell.row, 2).value
SupplierTable!Status = xlsheet.Cells(MyCell.row, 1).value
SupplierTable!LastUpdated = Now()
SupplierTable.Update

End If

Else
Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")

SupplierTable.AddNew
SupplierTable!SupplierName = SupplierName
SupplierTable!Address = xlsheet.Cells(MyCell.row, 7).value
TeleFaxStr = Split(xlsheet.Cells(MyCell.row, 6).value, "FAX-")
SupplierTable!Telephone = Trim(Right(TeleFaxStr(0), Len(TeleFaxStr(0)) - 4))
SupplierTable!FaxNumber = Trim(TeleFaxStr(1))
SupplierTable!RiskFactor = xlsheet.Cells(MyCell.row, 2).value
SupplierTable!Status = xlsheet.Cells(MyCell.row, 1).value
SupplierTable!LastUpdated = Now()
SupplierTable.Update

End If

Else
Exit For
End If
Next MyCell
Dim DateStr() As String

'Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")
''Check to see if the recordset actually contains rows

Set SupplierTable = Nothing 'Clean up
errhandle:
Resume Next
'msgstr = msgstr & CStr(MyCell.row) & " "
xlsheet.Close
xlBook.Close
xlapp.Quit
Set xlsheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
MsgBox ("Approved Supplier List Updated")
End Function

The data imports into mu access table but stops at the first bracket?

sample data in excel sheet:

APPROVED M AIR RECEIVERS Design and manufacture of pressure vessels and air receivers ABBOTT & CO (NEWARK) LTD TEL-01636 704208 FAX-01636 705742 Newark Boiler Works, Northern Road, Newark, NG24 2EJ APPROVED M AGENCY The provision of temporary and permanent staff resourcing ABC CONTRACT SERVICES LIMITED TEL-01582 692692 FAX-08700 500357 800 The Boulevard, Capability Green, Luton, Bedfordshire, LU1 3BA APPROVED M LIGHTING Hazardous Area & Industrial Lighting A-BELCO LTD (HADAR LIGHTING) TEL- 01670 813275 FAX- 01670 851141 Jubilee Industrial Estate, Ashington, Norhumberland NE63 8UG

The 5th row is where the problem is abbot and co will import n stop missing out the brackets (I need all the data). same for the last row
A-BELCO LTD will import (HADAR LIGHTING) does not.

Any help is much appreciated.

Ifshaanm

 

[pr2-eugin]

Hello Ifshaanm, Welcome to AWF

To help us help you better I suggest you please have a look at the following threads :
Please use Code Tags when posting VBA Code
How to Show your Table in a Post

 

[Ifshaanm]

Hi sorry new to forum.

 Function SyncSuppliers()
 On Error GoTo errhandle
 Filename = DLookup("SupplierPath", "Setup", "SetupActive = True")
 If Filename = "" Then
    Exit Function
End If
 Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Open(Filename)
Set xlsheet = xlBook.Sheets("Cordell Suppliers")
 xlapp.Visible = False
 'delete all existing suppliers
'Dim StrSQL As String
'
'StrSQL = "Delete * from [Approved Suppliers]"
'DoCmd.SetWarnings False
'DoCmd.RunSQL StrSQL
'DoCmd.SetWarnings True
  
 'Supplier Section
Dim SuppID As Variant
Dim SupName() As String
Dim SupplierName As String
Dim SupplierTable As DAO.Recordset
Dim TeleFaxStr() As String
 Set xlRange = xlsheet.Range("E11:E1000")
 For Each MyCell In xlRange
    If (xlsheet.Cells(MyCell.row, 1).value <> "") Then
        
        If xlsheet.Cells(MyCell.row, 5).value = "" Then
            SupplierName = Trim(LastSupName) & " (2)"
        Else
            SupName = Split(xlsheet.Cells(MyCell.row, 5).value, " (")
            SupplierName = Trim(SupName(0))
            LastSupName = Trim(SupName(0))
            
        End If
         SuppID = DLookup("[SupplierID]", "[Approved Suppliers]", "[SupplierName]= '" & SupplierName & "'")
        
        'Supplier already Exists
        If Not IsNull(SuppID) Then
            
            Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")
            
            SupplierTable.FindFirst "SupplierID = " & SuppID
            If Not SupplierTable.NoMatch Then
            
            SupplierTable.Edit
            SupplierTable!SupplierName = SupplierName
            SupplierTable!Address = xlsheet.Cells(MyCell.row, 7).value
            TeleFaxStr = Split(xlsheet.Cells(MyCell.row, 6).value, "FAX-")
            SupplierTable!Telephone = Trim(Right(TeleFaxStr(0), Len(TeleFaxStr(0)) - 4))
            SupplierTable!FaxNumber = Trim(TeleFaxStr(1))
            SupplierTable!RiskFactor = xlsheet.Cells(MyCell.row, 2).value
            SupplierTable!Status = xlsheet.Cells(MyCell.row, 1).value
            SupplierTable!LastUpdated = Now()
            SupplierTable.Update
                
            End If
        
        Else
            Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")
        
            SupplierTable.AddNew
            SupplierTable!SupplierName = SupplierName
            SupplierTable!Address = xlsheet.Cells(MyCell.row, 7).value
            TeleFaxStr = Split(xlsheet.Cells(MyCell.row, 6).value, "FAX-")
            SupplierTable!Telephone = Trim(Right(TeleFaxStr(0), Len(TeleFaxStr(0)) - 4))
            SupplierTable!FaxNumber = Trim(TeleFaxStr(1))
            SupplierTable!RiskFactor = xlsheet.Cells(MyCell.row, 2).value
            SupplierTable!Status = xlsheet.Cells(MyCell.row, 1).value
            SupplierTable!LastUpdated = Now()
            SupplierTable.Update
            
        End If
    
    Else
        Exit For
    End If
 Next MyCell
 Dim DateStr() As String
 'Set SupplierTable = CurrentDb.OpenRecordset("Approved Suppliers")
 ''Check to see if the recordset actually contains rows
'If Not (SupplierTable.EOF And SupplierTable.BOF) Then
'
'    TodaysDate = Date
'    SupplierTable.MoveFirst
'    Do Until SupplierTable.EOF = True
'        'Perform an edit
'        DateStr = Split(SupplierTable!LastUpdated, " ")
'        If DateStr(0) <> Date Then
'            SupplierTable.Edit
'            SupplierTable!RiskFactor = "BANNED"
'            SupplierTable.Update
'        End If
'        'Move to the next record. Don't ever forget to do this.
'        SupplierTable.MoveNext
'    Loop
'End If
 'SupplierTable.Close 'Close the recordset
Set SupplierTable = Nothing 'Clean up
 errhandle:
Resume Next
'msgstr = msgstr & CStr(MyCell.row) & "  "
 xlsheet.Close
xlBook.Close
xlapp.Quit
 Set xlsheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
 MsgBox ("Approved Supplier List Updated")
 End Function