Help Importing Excell data to Access table

mercredi 25 mars 2015

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

Help Importing Excell data to Access table

0 commentaires:

Enregistrer un commentaire

Labels