Real Tuff One

[dan1dyoung]

Hi,

This is what i want to do:

Have a button on a form that when pressed opens a file browse, allows you to pick a text file (May contain different values and in future the structure may change slightly), then import the text file contents into a temp table (2 fields, Setting & Value), then run a query to take different values from the temp table and put them in to different fields in to different tables linked to the same main record where the button is, then save the record and all linked tables data, and then delete the temp table, and display a message box saying something like done.

Each import file will be a single record, but has to many fields to be in one table

I also need to extract only part of Field 1 (Sample Below), the part after the = (150 in below)

0x6A,0x10,0x12 = 150

Thanks

Dan

 

[gemma-the-husky]

all do-able do it in stages, so each bit works and build it all up

pick a file - common file open save dialogs

import - docmd.transfertext (depending on the import structure)

then develop a series of manual queries to manipulate the data as you want

then put them together

docmd.openquery etc etc

 

[dan1dyoung]

Gemma,

Thanks for a quick reply.

I have seen the code on here before for a browse so i should be able to sort that, but the excel sheet will have 400+ records with 2 fields (Setting & Value), but record 1 field value may need to go into table 3 field 2, and record 2 field value may need to go in to table 7 field 22. I am only interested in transferring the value field to access as it will tie up with a field that is the setting name from the excel file, as there is 400+ records (Which will be 400+ fields in a table(s)) i need multiple tables to hold the info and then link them somehow.

Probably is easier than i am thinking, but after a long day seems even harder than anything!!

Thanks

Dan

 

[boblarson]

If you have to put the data in to various tables and fields based on certain criteria, I might suggest importing it via code instead of the import feature. You can use the Excel Object model to connect to the spreadsheet and read the cells and then place them in the areas you want based on functions or select case statements.

I can supply sample code, if no one else does, when I get home tonight.

 

[dan1dyoung]

Bob,

Thanks, i would prefer code anyway as i want it to be standard user-proof like just a browse and then an OK button, and it uses criteria set by me so the user can not mess it up.

A sample to put me on the right track would be fantastic

Thanks

Dan

 

[boblarson]

This is a bit long and hopefully you can pull out what you need. I tried to cut out most of the stuff that is dealing with other things, so it isn't totally complete. But, hopefully you'll get the idea.

Public Sub ScrapeData()
Dim rstData As ADODB.Recordset, rstMeasureID As ADODB.Recordset, rstMeasures As ADODB.Recordset
Dim strMeasureText As String
    Dim lngCountDates As Long, lngCountDone As Long, strRange As String
    Dim strType As String, strSheetType As String, blnNoMonth As Boolean
    Dim strFileName As String
    Dim frm As Form
    Dim strRepFileName As String
    Dim strCenterID As String
    Dim xlApp As Excel.Application
    Dim strWB as Excel.Workbook
        ' initializes Excel
        Set xlApp = New Excel.Application
        ' makes the workbook visible
        xlApp.Visible = True
        ' initializes the counter
        intCount = 0
        ' loop until the counter equals the items in the list
        Do Until frmAggMain.lst1.ListCount = 0
            ' sets the variable to the workbook path and name
            strWB = frmAggMain.lst1.List(0)            
            ' opens the workbooks listed in the listbox
            blnErr = False
            Set xlWB = xlApp.Workbooks.Open(strWB)
     '      WORKBOOK OPENS UP
           ' opens the POF tab
            xlApp.Worksheets("POF").Visible = True
            xlApp.Worksheets("POF").Select
            ' opens recordset to write to
            OpenDbConn
             Set rstData = New ADODB.Recordset
             rstData.Open "tblSpreadsheetOrgNames", cnnCurrent, adOpenDynamic, adLockOptimistic
            xlApp.Worksheets("POF").Range("A1").Select
            strCenterName = xlApp.Worksheets("POF").Range("A1")
            If strCenterName = "" Then
                MsgBox "Center Name missing from spreadsheet on " & vbCrLf & _
                       strWB, vbCritical, "Missing Center Name"
                Exit Sub
            Else
                If FindCenter(strCenterName) = 0 Then
                    MsgBox "No center found -- canceling operation!", vbCritical, "CENTER NOT FOUND"
                    Exit Sub
                End If
            End If
            OpenDbConn
            xlApp.Worksheets("POF").Range("A4").Select
            'ActiveSheet.Range("A4").Select
            frmAggMain.SetFocus
            lngCountDates = 0
            ' finds the number of possible date values to check
            Do Until ActiveCell.Value > CDate(strDate2GoTo) Or ActiveCell.Value = ""
                lngCountDates = lngCountDates + 1
                ActiveCell.Offset(1, 0).Select
            Loop
            lngCountDone = 4
            
           Do Until lngCountDone = lngCountDates + 4
                strRange = "A" & lngCountDone
                ActiveSheet.Range(strRange).Select
                dteDataDate = ActiveCell.Value
                strDate = dteDataDate
                strAddress = ActiveCell.Address
                arrAddress = Split(strAddress, "$", , vbTextCompare)
                strCol = arrAddress(1)
                intRow = arrAddress(2)

                ActiveSheet.Range("B2").Select
                strAddress = ActiveCell.Address
                arrAddress = Split(strAddress, "$", , vbTextCompare)

                strCol2 = arrAddress(1)
                Set rstMeasureID = New ADODB.Recordset
                Set rstMeasures = New ADODB.Recordset
                strSQL = "SELECT tbl_measures.measure_association, spreadsheet_text From tbl_measures"
                rstMeasureID.Open strSQL, cnnCurrent, adOpenDynamic, adLockOptimistic
                rstMeasures.Open "tbl_measure_data", cnnCurrent, adOpenDynamic, adLockOptimistic

                Do Until ActiveCell.Column = 54
                    ActiveSheet.Range(strCol2 & "2").Select
                    strMeasureText = Trim(ActiveCell.Text)
                    rstMeasureID.MoveFirst

                    Do Until rstMeasureID(1) = strMeasureText
                        rstMeasureID.MoveNext
                        If rstMeasureID.EOF Then
                            Exit Do
                        End If
                    Loop
                    
                    ActiveSheet.Range(strCol2 & CStr(intRow)).Select
                    If ActiveCell.ColumnWidth <> 0 Then
                        If ActiveCell.Text <> "" Then
                            If Selection.Interior.ColorIndex <> xlNone Then
                                With rstMeasures
                                    .AddNew
                                    .Fields("site_id") = lngCenterID
                                    .Fields("measure_date") = CDate(strDate)
                                    .Fields("measure_id") = rstMeasureID(0)
                                    .Fields("collab_id") = lngCollabID
                                    If IsNumeric(ActiveCell.Text) Then
                                        .Fields("measure_data") = ActiveCell.Text
                                    Else
                                    End If
                            End If
                                    .Fields("measure_type") = "POF"
                                    .Fields("date_stamp") = Format(Now, "mm/dd/yyyy")
                                    .Fields("time_stamp") = Format(Now, "hh:nn:ss")
                                    .Fields("user_stamp") = strUserName
                                    .Update
                                End With
                            End If
                        End If
                    End If
                    ActiveCell.Offset(0, 1).Select
                    strAddress = ActiveCell.Address
                    arrAddress = Split(strAddress, "$", , vbTextCompare)
                    strCol2 = arrAddress(1)
                    frmAggMain.Refresh
                Loop
                lngCountDone = lngCountDone + 1
            Loop
                    

                    ActiveSheet.Range(strCol2 & CStr(intRow)).Select
                    If ActiveCell.Text <> "" Then
                        If Selection.Interior.ColorIndex <> xlNone Then
                            With rstMeasures
                                .AddNew
                                .Fields("site_id") = lngCenterID
                                .Fields("measure_date") = CDate(strDate)
                                .Fields("measure_id") = rstMeasureID(0)
                                If IsNumeric(ActiveCell.Text) Then
                                    .Fields("measure_data") = ActiveCell.Text
                                    .Fields("collab_id") = lngCollabID
                                End If
                         End If
                                .Fields("measure_type") = "POS"
                                .Fields("date_stamp") = Format(Now, "mm/dd/yyyy")
                                .Fields("time_stamp") = Format(Now, "hh:nn:ss")
                                .Fields("user_stamp") = strUserName
                                .Update
                            End With
                        End If
                    End If

                    ActiveCell.Offset(0, 1).Select
                    strAddress = ActiveCell.Address
                    arrAddress = Split(strAddress, "$", , vbTextCompare)
                    strCol2 = arrAddress(1)
                Loop
                lngCountDone = lngCountDone + 1

            Loop

            frmAggMain.lst1.Refresh
            intCount = intCount + 1
            xlWB.Close False

        Loop

        frmAggMain.lst1.Clear

        xlApp.Quit
        rstMeasures.Close
        rstMeasureID.Close
        Set xlApp = Nothing
        Set rstMeasures = Nothing
        Set rstMeasureID = Nothing
        End If

    End If

    Exit Sub

Public Sub OpenDbConn()
On Error GoTo err_handler
    strConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPathName & ";Persist Security Info=False"
errResume:
    blnRstOpen = True
    Set cnnCurrent = New ADODB.Connection
    Set rstConn = New ADODB.Recordset
    Set rstCenter = New ADODB.Recordset

    With cnnCurrent
        .ConnectionString = strConnStr
        .ConnectionTimeout = 30
    End With

    cnnCurrent.Open strConnStr
    Exit Sub
err_handler:
    If Err.Number = -2147467259 Then
        strDbPathName = App.Path & "\KMSDataScraper.mdb"
        strConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPathName & ";Persist Security Info=False"
        GoTo errResume
    Else
        MsgBox Err.Description, vbExclamation, "Error #: " & Err.Number
    End If
End Sub

 

[dan1dyoung]

Bob,

WOW!!!

I must admit i have read it all 2 times now and i am still lost, what are the references to specific cells like A1 & A4 & B2??

I assume this is looking at taking the data directly for excel rather than going through a temp table??

I will read it again and see how it goes

Thanks

Dan

 

[boblarson]

Yes, it is taking data directly from the Excel spreadsheet and not going through the import process. I was figuring that you would need something similar to be able to fill your need for conditional location of the data.

 

[dan1dyoung]

Bob,

Where do i:

1) Extract the right part of the field (After the =)

I also need to extract only part of Field 1 (Sample Below), the part after the = (150 in below)

0x6A,0x10,0x12 = 150

2) Map the fields in the excel sheet to the tables and fields in access, e.g

Excel cell A1 to access tblsample1 field samplefield1
Excel cell A2 to access tblsample2 field samplefield5
e.t.c

3) Add the variable for the file, as i want this to come from a browse on the form

 

[dan1dyoung]

Right,

Solved no. 1 one way but would rather do it differently, i have done it using the 15 spaces from the left but would rather say any data after the = minus the one space after the = before the data is the Value

but if there is no space then it is just data.

Some more syntax sample so you see why -17 will not always work

0x6A,0x10,0x12 = 150
0x6C,0x12,0x3EE= 1000
0x6B,0x19,0x33 ===80
0x6C,0x12,0x34 = -2000


1) Extract the right part of the field (After the =)

Quote:
I also need to extract only part of Field 1 (Sample Below), the part after the = (150 in below)

0x6A,0x10,0x12 = 150

with this

Query
Test: Right$([Value],Len([Value])-17)

Field
=Right$([Value],Len([Value])-17)

Where Value is the field name

Thanks

Dan

 

[boblarson]

Here's a function I wrote that SHOULD get you what you want. You can modify it so that you aren't using a function, if you wish. Or you can just put that function into a module and then call it, passing the string to test to it.

Public Function ReturnString(strString As String) As String
    
    ReturnString = Right(strString, Len(strString) - InStrRev(strString, "=", , vbTextCompare))
    
End Function

As far as the other questions:

2) Map the fields in the excel sheet to the tables and fields in access, e.g

Excel cell A1 to access tblsample1 field samplefield1
Excel cell A2 to access tblsample2 field samplefield5
e.t.c

You would open the ADO connection and then a recordset object for each table you will want to write to. Then, you can write to them by using a variant of:

                                With rstTblSample1
                                    .AddNew
                                    .Fields("SampleField1") = Activesheet.Range("A1").Value
                                    .Fields("SampleField2") = Activesheet.Range("A2").Value
                                    .Update

The part of the
3) Add the variable for the file, as i want this to come from a browse on the form
[/quote]

Check this post out for the browse (also you can search on "browse for file" as there are MANY examples on the forum).
http://www.access-programmers.co.uk/forums/showthread.php?t=97638&highlight=browse

 

[dan1dyoung]

Bob,

Thanks, just trying to convert it for a query, but can not get it right??

I have so far

Test: Right$([Value],Len([Value])-InStrRev([Value],"=", ,[vbTextCompare]))

But it does not like the second , so i have removed it but it then asks for the vbTextValue??

What i was planning as i could not get to grips with your code (Which is probably just what i want as i want the cleanest way), was to import the excel file into a TEMP table (That will be deleted after the import is finished) and then using an append query with the code above to take just the actual values and put them into different fields in different tables.

Thanks

Dan

 

[boblarson]

Whatever works for you is fine. I know, from experience, that a temp table can be actually more problematic at times, as it will not necessarily be able to import exactly as you want things, IF (and that is key) the data is not consistent each time. If it is consistent, and you can get it that way, then go for it. The one problem with using a temp table is also that it will cause your database to grow much quicker and you need to remember to compact frequently.

As for using the formula in a query (instead of referring to the function), use this:

YourCustomNameHere: Right([FieldNameHere],Len([FieldNameHere])-InStrRev([FieldNameHere],"="))

 

[dan1dyoung]

Sorry Bob,

I had my screen minimised so i only saw the first part you wrote and not your explanation of how to map the fields, e.t.c. Will try to do it that way then as it is a little more clear now.

What a prat, thanks

Also just searched the forum but can not find an answer, using your last bit of code in a query (Works great), how can i remove blank spaces??

0x6A,0x10,0x12 = 150 (So it shows just 150, not space 150)

But the below still shows as -2000 not 2000

0x6C,0x12,0x34 = -2000

Thanks

Dan

 

[boblarson]

you could use:

YourCustomNameHere: Trim(Right([FieldNameHere],Len([FieldNameHere])-InStrRev([FieldNameHere],"=")))

 

[dan1dyoung]

Bob,

Used below (My field is called Value):

Trim(Right([Value],Len([Value])-InStrRev([Value],"=")))

but get the error below:

Circular reference caused by alias 'Value' in query definition's SELECT list.

Using Access 2000 if that may be a reason

Thanks

Dan

 

[boblarson]

If the previous code worked and it is now giving you an error based on using the Trim function, I don't know what to tell you. Can you post a stripped down version of your database so I can take a look?

One other thought too - Your field name should not be an Access reserved key word as it can cause you problems. You should never use reserved key words as field names or object names. Value is a reserved key word. Try changing your field name to something else (even if it is just like aValue).

 

[dan1dyoung]

Bob,

Changed the name and it works a treat, never knew there were reserved field names (Learn something new every day).

Will try to work through your main code for importing directly when i am more awake, maybe tomorrow.

Thanks

Dan

 

[dan1dyoung]

Bob,

Am still trying to work my way through it but thougt i would post the files so you can see what i am looking at as it will then be easier to understand what i am rambling about.

There are several tasks i am trying to do:

1) Import the text file CurrentSet.txt (Which i will also need to be able to import the same file structure but with different names like Settings1.txt & Settings2.txt, 3 names total) which is why i want to use the browse to select the file and not a hard-coded name, and then extract certain records Value field to different fields in different tables in the database.

2)Import the excel file intlogdata.xls which has a totally different structure, and then extract certain field values of every record to different the same field but different records in different tables in the database.

3) Import the excel file extlogdata.xls which has a totally different structure, and then extract certain field values of every record to different the same field but different records in different tables in the database.

And also be able to covert/change the code to allow me to use it to also read the same data but from .xls, .tx, & .txt files (Called intlogdata, extlogdata, currentset, e.t.c) May be neally the same except the app.excel references??


To try to explain the import, record 38 in table CurrentSet or TEMPCurrentSet (which i will need to change at some point before it is permantly saved to 10.00 or 10.0 from 1000) will go into tblSNCoolDetail field SNCool_SASetpoint, while record 33 in table CurrentSet or TEMPCurrentSet will need to go into table tblTempSetpointDetail field SA_Setpoint (And will also need changing to 21.50 from 2150)

Some vaues are 1 decimal places, some are 2, 3, & 4 so need to add this to the import per field/record or on the table where the end value is stored



NB:
I notice that with the current browse i have filtered on *.xls but when you go into folders you still see text files, word files, e.t.c where you do not if you open excel and look through folders??

Thanks

Dan

 

[dan1dyoung]

Still trying to solve this one (Probably not the best way at present but it is helping me get to grips with it), quick question - How can i add multiple statements to a query, as i need a query statement per record, which as you saw in the attached is currently around 450+ and do not want 450+ querie's.

Like the below but it does not work??


INSERT INTO tblTempSetpointDetail ( ERS1_BreakPoint )
SELECT [TEMPCurrentSet].[NewActValue]
FROM TEMPCurrentSet
WHERE ((([TEMPCurrentSet].[Setting])="ERS_BreakPoint"));
AND
INSERT INTO tblTempSetpointDetail ( ERS2_X1 )
SELECT TEMPCurrentSet.NewActValue
FROM TEMPCurrentSet
WHERE (((TEMPCurrentSet.Setting)="ERS_User-X1"));

Thanks

Dan