Import Specific Cells from variable sheets into Access Tables. (1 Viewer)

travisdh · Jan 7, 2011

[Solved] Import Specific Cells from variable sheets into Access Tables.

Hello Once again, I am trying to get an import system running in the backend database to import results into the appropiate tables. Some parts work quite well where the format of the spreadsheet (or CSV) is that of headers and so forth, but there are a few reports which tend to be somewhat of a pain to import.

I have spreadsheets supplied in format PG*.xls, and to make life a little bit more difficuilt they are not really normalised (except that the results are always in the same cells) and the headers and so on change a little. In addition in the one spreadsheet there are variable sheets with different names. Every sheet needs to be imported but to be honest i am not sure where to start with VBA allowing me to import into the access tables, but then also how to parse through the names of the sheets to get all of the data out when the names are not fixed or known.

Is anyone able to offer some help with this one, i have listed below some of the cells of interest from the workbook, the aim is to eventually get it to parse through a directory looking for any PG*.cls files and import them, then to move them to an "Imported" folder so they are not duplicated.

Thanks!

TBL_ESDAT_SAMPLES
SAMPLE_CODE = C16
LOC_CODE = C6
LABNAME = "SGS"

TBL_ESDAT_CHEMISTRY
SAMPLE_CODE = C16
ORIGINAL_CHEM_NAME = B22
RESULTVALUE = C22
COMMENTS = B25
VISIBLE = "1"

travisdh · Jan 7, 2011

So i got it to import a specific file using this code below, but how do i now get it to import anything with PG*.xls and also to scan through every worksheet within the spreadsheet?

Code:

Public Sub ADD()
Dim myRec As DAO.Recordset
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject("L:\**\**\**\PG75072.xls")
Set xlsht = xlWrkBk.Worksheets(1)
Set myRec = CurrentDb.OpenRecordset("TBL_ESDAT_SAMPLES", dbOpenDynaset)
myRec.AddNew
myRec.Fields("SAMPLE_CODE") = xlsht.Cells(16, "C")
myRec.Fields("LAB_SAMPLEID") = xlsht.Cells(16, "C")
myRec.Fields("LOC_CODE") = xlsht.Cells(6, "C")
myRec.Fields("LAB_NAME") = "SGS"
myRec.Update
Set myRec = CurrentDb.OpenRecordset("TBL_ESDAT_CHEMISTRY", dbOpenDynaset)
myRec.AddNew
myRec.Fields("SAMPLE_CODE") = xlsht.Cells(16, "C")
myRec.Fields("ORIGINAL_CHEM_NAME") = xlsht.Cells(22, "B")
myRec.Fields("RESULT_VALUE") = xlsht.Cells(22, "C")
myRec.Fields("COMMENTS") = xlsht.Cells(25, "B")
myRec.Fields("VISIBLE") = 1
myRec.Update

End Sub

travisdh · Jan 7, 2011

Got it working with this, not the neatest but it works

Code:

Private Sub ImportMultiple()
Dim strFile As String
Dim strFileList() As String
Dim intFile As Integer
Dim filename As String
Dim path As String
Dim Response As String
Dim myStrFilter As String
Dim strInputFileName As String
Dim strSQL As String
path = "L:\**\**\**\**\"
strFile = Dir(path & "PG*.xls")
'Lists each file in that directory with .csv extension and stores filename in an array
While strFile <> ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
If intFile = 0 Then

Exit Sub
End If
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
Dim myRec As DAO.Recordset
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Dim NumSheets As Integer
Dim lcount As Integer
Dim lNum As Integer
Dim newfile As String

Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject(filename)
NumSheets = xlWrkBk.Worksheets.Count
lNum = 1
Do Until lNum = NumSheets + 1
Set xlsht = xlWrkBk.Worksheets(lNum)
Set myRec = CurrentDb.OpenRecordset("TBL_ESDAT_SAMPLES", dbOpenDynaset)
myRec.AddNew
myRec.Fields("SAMPLE_CODE") = xlsht.Cells(16, "C")
myRec.Fields("LAB_SAMPLEID") = xlsht.Cells(16, "C")
myRec.Fields("LOC_CODE") = xlsht.Cells(6, "C")
myRec.Fields("LAB_NAME") = "SGS"
myRec.Update
Set myRec = CurrentDb.OpenRecordset("TBL_ESDAT_CHEMISTRY", dbOpenDynaset)
myRec.AddNew
myRec.Fields("SAMPLE_CODE") = xlsht.Cells(16, "C")
myRec.Fields("ORIGINAL_CHEM_NAME") = xlsht.Cells(22, "B")
myRec.Fields("RESULT_VALUE") = xlsht.Cells(22, "C")
myRec.Fields("COMMENTS") = xlsht.Cells(25, "B")
myRec.Fields("RESULT_UNIT") = "mg/kg"
myRec.Fields("VISIBLE") = 1
myRec.Update

lNum = lNum + 1
Loop
xlWrkBk.Close (True)
xl.Application.Quit

newfile = "L:\**\**\**\**\Imported\" & strFileList(intFile)
Name filename As newfile
Next intFile
End Sub

Import Specific Cells from variable sheets into Access Tables. (1 Viewer)

travisdh

Registered User.

travisdh

Registered User.

travisdh

Registered User.

Similar threads

Users who are viewing this thread