excel / access question

[CHAOSinACT]

i've linked data from excel spreadsheets often to my database; wondering if there is any way to pause for user input? i need to open the sheet and have the user select a cell or 2; the spreadsheets are dynamic and no way to predict which cell the data will be in.

 

[Galaxiom]

You code would first open the spreadsheet and prompt the user to select the cells. The selection information would be stored in variables.

Then you run the import using the information as required.

 

[CHAOSinACT]

i'm just not familiar with the excel event model to know exactly how to get it to "pass" back those variables.... any good web sites you would recommend?

 

[chergh]

It depends what you want to pass back and to what.

Are your users just highlighting a few cells and you want to pass back the value in each cell?

Do cells need to be done in a specific order?

Are you over writing existing data in the spreadsheet?

You've not given us much to go. If you provide more information about what you want to do we can give better answers.

 

[CHAOSinACT]

fair enough; to be honest I'm not positive how it will work. i'm trying hard to figure out ways to do what we need. tragically i've come to accept that we simply HAVE to pause the program and let the user do his thing in excel (its a claim sheet) and the problem is each one is unique...

i need to be able to summarize what they have done and bring the totals back to access. there is no way to know which cell it will be in, i think they user will have to select the cells to tell the access application but how i fire an excel event within access i'm not sure. i've pushed and pulled data out of cells no problems but events over there from here? no idea....

 

[wiklendt]

CHAOSinACT, don't really know what your intent is with the spreadsheet, but sounds like you're linking it for no reason? You *just* want a couple of cells' worth of values?

However, that being said: you're doing sounds similar to what i'm currently working on.

I've had quite a bit of progress, see if you can see anything useful in my code and feel free to use any of it. (Some was provided by others here).

What this code does currently: opens an existing workbook; adds an additional worksheet and adds headers and formulae; finds data in the existing (original) sheet using a "For" loopy thing - that is, finds a "label" cell (a cell whose value doesn't change, but location in the sheet might, and i know is next to the data i want), finds the cell next to it, and grabs the value, puts it into a declared string.

I'm still developing and testing it, so don't take it as gospel! Here it is, i've highlighted in red about 5 bits throughout, which i think you will find most useful, but don't forget to declare all your objects and string variables!

Option Compare Database

Function fImportPhoenix() As String
On Error GoTo Err_fImportPhoenix

   [COLOR="Red"][B] Dim i As Long
    Dim Msg As String[/B][/COLOR]

    Dim fld As Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
   
' ====== OPEN WORKBOOK AND SHEET ================================================ '
' Notes: WORKING

    Dim strDialogTitle As String
    Dim strPath As String
        
    strDialogTitle = "Select a file for import"
    strPath = GetOpenFile_CLT(".\", strDialogTitle) ' just a generic file dialog
       
   'If no file was selected then the PathStrg variable will be empty.
   'If there was a file selected then.....
    
   [COLOR="red"][B] Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim Range As Object[/B][/COLOR]
   
    If strPath <> "" Then
   [COLOR="red"][B]
        Set ApXL = CreateObject("Excel.Application") 'invoke excel application
        Set xlWBk = ApXL.Workbooks.Open(strPath) 'open the selected file
        Set xlWSh = xlWBk.Worksheets("Sheet1")[/B][/COLOR]
        ApXL.Visible = True ' don't show the file to the user
        
' ====== ADD NEW WORKSHEETS ===================================================== '
' Notes: DEVELOPING, but all WORKING unless otherwise stated
        
        Dim xlWShExtract As Object
        Dim xlWShMarkers As Object
        Dim xlWShExRules As Object
        
        ' check if additional worksheets exists, if not create them
        On Error Resume Next
            Set xlWShExtract = xlWBk.Sheets("Extract")
            Set xlWShMarkers = xlWBk.Sheets("Markers") ' this one yet to code
            Set xlWShExRules = xlWBk.Sheets("ExRules") ' this one yet to code
        On Error GoTo Err_fImportPhoenix
        
        ' ------ "EXTRACT" Results Extraction Worksheet ------------------------- '
        ' this worksheet will be used for importing into a temporary Access table
        
        If Not xlWShExtract Is Nothing Then
            'sheet has already been generated
            '(and thus imported, once i finish the code!, so exit for this file)
            'maybe check that the record exists...?
            'and/or ask if user wants to re-import? overwrite? etc...
            'End Function
        Else
            'does not exist, so add it
            ApXL.Worksheets.Add.Move After:=ApXL.Worksheets(ApXL.Worksheets.Count)
            ApXL.Sheets(ApXL.Worksheets.Count).Name = "Extract"
            Set xlWShExtract = xlWBk.Sheets("Extract")
            
            'and add appropariate headers
            With xlWShExtract
                .Range("A1") = "Antimicrobial"
                .Range("B1") = "Qualifier"
                .Range("C1") = "Value"
                .Range("D1") = "SIR"
                .Range("E1") = "Reading"
            End With

            'copy over information from Sheet1.
            With xlWSh
                .Activate
                For i = 1 To .UsedRange.Rows.Count
                    If .Cells(i, 1) = "Isolate AST Results" Then
                        .Cells(i + 2, 1).Activate
'' NUT OUT FROM HERE
'' -----------------
                        '' Error 424 on next line - Object Required
                        .Range(i + 2, 1).CurrentRegion
                    End If
                Next
            End With
    
'            With xlWShExtract
'                .Activate
'                .ActiveSheet.Paste
'                .Sheets(1).Select
'                .Range(Selection + 2, Selection.End(xlDown)).Copy
'                .Sheets("Extract").Activate
'                .Sheets("Extract").Paste
'            End With
'' -----------------
'' TO HERE
            
            'add formulae to get the desired data
            With xlWShExtract
                ' -------- for qualifier
                ' Must use RC[3] instead of "E2" for range source in formula  (relative reference)
                .Range("B2").FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""="",RC[3]))),LEFT(RC[3],2),IF(OR(LEFT(RC[3],1)="">"",LEFT(RC[3],1)=""<""),LEFT(RC[3],1),""=""))"
                'now copy down the same number of rows as exists in column A
                ' (yet to do)
                
                ' -------- for value
                ' chagned B2 to RC[-1] and E2 to RC[2] (relative reference)
                .Range("C2").FormulaR1C1 = "=IF(RC[-1]<>""="",RIGHT(RC[2],LEN(RC[2])-LEN(RC[-1])),RC[2])"
                'now copy down the same number of rows as exists in column A
                ' (yet to do)
            End With
        
            GoTo Clean_up
        
        End If
        
        ' ------ "MARKERS" Marker Rules Worksheet ------------------------------- '
        ' this worksheet will be used for importing into a temporary Access table
        
        ' copy and adpat from 'EXTRACT' once it's working
        ' have to try to 'skip' the blank rows... maybe a loop to find cells containing 'rule'?
        ' could be tricky... :-/
        
        ' ------ "RULES" Expert Triggered Rules Worksheet ----------------------- '
        ' this worksheet will be used for importing into a temporary Access table
        
        ' copy and adpat from 'MARKERS' once it's working
        

' ====== FIND PRELIMINARY DATA ================================================== '
' Notes: WORKING
    
    Dim strSample As String
    Dim strOrganism As String
    Dim strTestName As String
    
[COLOR="Red"][B]        ' find the sample name and copy to string
        With xlWSh
            .Activate
            For i = 1 To .UsedRange.Rows.Count
                If .Cells(i, 1) = "Accession #:" Then
                    .Cells(i, 2).Activate
                    strSample = .Cells(i, 2).Value
                End If
            Next
        End With
[/B][/COLOR]        
        ' find the organism name and copy to string
        With xlWSh
            For i = 1 To .UsedRange.Rows.Count
                If .Cells(i, 1) = "Organism Name:" Then
                    .Cells(i, 2).Activate
                    strOrganism = .Cells(i, 2).Value
                End If
            Next
        End With
        
        ' find the test name and copy to string
        With xlWSh
            For i = 1 To .UsedRange.Rows.Count
                If .Cells(i, 1) = "Test Name:" Then
                    .Cells(i, 2).Activate
                    strTestName = .Cells(i, 2).Value
                End If
            Next
        End With
        
        'copy all three strings to temporary table
        ' (yet to do) = INSERT statement?

' ====== CLEAN UP =============================================================== '
' Notes: WORKING

Clean_up:
        ' delete sheet while testing (code works!)
        ApXL.DisplayAlerts = False
        xlWBk.Sheets("Extract").Delete
        'xlWBk.Sheets("Markers").Delete
        'xlWBk.Sheets("ExRules").Delete
        ApXL.DisplayAlerts = True
    
[COLOR="Red"][B]        ' close instance of Excel
        xlWBk.Save
        xlWBk.Close
        ApXL.Quit
        Set xlWShExtract = Nothing
        Set xlWSh = Nothing
        Set xlWBk = Nothing
        Set ApXL = Nothing[/B][/COLOR]
        
        MsgBox "I've left everything neat and tidy for you"
        
   End If

Exit_fImportPhoenix:
    Exit Function

' ====== ERROR HANDLER ========================================================== '

Err_fImportPhoenix:
    
    ' delete sheet while testing (code works!)
    ApXL.DisplayAlerts = False
    xlWBk.Sheets("Extract").Delete
    'xlWBk.Sheets("Markers").Delete
    'xlWBk.Sheets("ExRules").Delete
    ApXL.DisplayAlerts = True
    
    ' close instance of Excel
    xlWBk.Save
    xlWBk.Close
    ApXL.Quit
    Set xlWShExtract = Nothing
    Set xlWSh = Nothing
    Set xlWBk = Nothing
    Set ApXL = Nothing

    ' "modFeatures" class module required for strings presented below
    Msg = "Error # " & Str(Err.Number) & Chr(13) & " (" & Err.Description & ")"
    Msg = Msg & Chr(13) & "in modImportPhoenix | fImportPhoenix"
    MsgBox Msg, vbOKOnly, fstrDBname & ": Error", Err.HelpFile, Err.HelpContext
    Resume Exit_fImportPhoenix

End Function

edit: forgot to say: triggered by a "Input from file" button on a form, and users (when i finish the code) don't have to do anything to any cell - all they have to do is point to the correct file (which, if you have standard file handling, you might be able to automate that bit too).

The code does all the 'cell finding' for you.

 

[CHAOSinACT]

Thanks for the reply I'll dig through it

I know I'm vague... Its actually open as to what we'll need to do.

but any extra excel code is a blessing, thank you

 

[wiklendt]

but any extra excel code is a blessing, thank you

tell me about it! finding access code is easy. finding excel code is easy. finding access code to manipulate excel is not so easy!

when i'm finished with my coding, i plan to put it up (maybe as a sample?) so that others might be able to use it (or bits of it, anyway).

 

[CHAOSinACT]

yeah i found the same thing! code linking it to outlook has been even worse