Results 1 to 11 of 11
  1. #1
    Join Date
    Jan 2008
    Posts
    37

    Unhappy Unanswered: Excel Automation Problem

    Hi i have two functions; both contain the code below (among other code) to insert entries into an excel spreadsheet; this code works for both functions separately. However when i run a sub that runs both functions one after another, the 1st functions entries are put on the spreadsheet but the second functions entries are not. Can anyone tell me why this is please?

    Set rs3 = db.OpenRecordset("Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_TU_CODE From [tblWorking] Where tblWorking.STU_TU_CODE is not null ")

    Dim objXL As Excel.Application 'Modify spreadsheet that informs SIS of allocation
    Dim objWkb As Object
    On Error Resume Next
    Set objXL = GetObject(, "Excel.Application")
    Set objWkb = objXL.Application.ActiveWorkbook
    Const xlDown = -4121
    With objXL.ActiveSheet.Range("a1").End(xlDown).Offset(1 , 0)
    .CopyFromRecordset rs3
    End With
    If objXL Is Nothing Then
    Set objXL = CreateObject("Excel.application")
    Dim objws As Excel.Worksheet
    Set objWkb = objXL.Workbooks.add
    Set objws = objWkb.Worksheets.add
    With objws
    objws.Range("A1").CopyFromRecordset rs3
    End With
    End If

    objXL.Visible = True
    objXL.WindowState = xlMinimized
    Set objXL = Nothing

  2. #2
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926
    The excellent excel automation example in the code bank may help you. Try taking a look at it.
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

  3. #3
    Join Date
    Jan 2008
    Posts
    37
    Hi pkstormy, I had a look at the example in the bank and changed my code a bit so that now in my first function the excel sheet is created and the second function just gets the open excel sheet but im still having a problem.
    Its highlighting With exSheet.Range("A1").End(xlDown).Offset(1, 0) and saying runtime error 1004 - application defined or object defined error. Ive searched for what this might be but cant find a solution ?

    With exSheet.Range("A1").End(xlDown).Offset(1, 0)
    .CopyFromRecordset rs3
    End With

  4. #4
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Please could you post what you have now? Please could you also use the code tags to preserve formatting? I would also say that the With... statement just makes the code harder to read - it is really intended to be more effocient (execution time & writing) when calling an object's functions\ methods multiple times, not just once.

    Anyhoo - repost and we'll see.
    Testimonial:
    pootle flump
    ur codings are working excelent.

  5. #5
    Join Date
    Jan 2008
    Posts
    37
    Ok here's whats in the first function, this is working fine:

    Code:
    Set rs3 = db.OpenRecordset("Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_TU_CODE From [tblWorking] Where tblWorking.STU_TU_CODE is not null ")
                    
        Dim exApp As Excel.Application
        Dim exBook As Excel.Workbook
        Dim exSheet As Excel.Worksheet
        Set exApp = New Excel.Application
    
        'Open the workbook
        Set exBook = exApp.Workbooks.add
        
        exApp.Visible = True
        
        exApp.Interactive = False
    
        'Instantiate the exSheet object to the specific work sheet you want to play with
        Set exSheet = exBook.Worksheets("Sheet1")
        
        exSheet.Activate
        
        If Not rs3.EOF Then
            exSheet.Range("A1").CopyFromRecordset rs3
        End If
        
        rs3.Close
        Set rs3 = Nothing
        
        Set exSheet = Nothing
        Set exBook = Nothing
        Set exApp = Nothing
    Then this is the code that is contained in the other function which is called after the first function; the bit in red is where i get the error

    Code:
    Set rs3 = db.OpenRecordset("Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_TU_CODE From [tblWorking] Where tblWorking.STU_TU_CODE is not null ")
                    
        Dim exApp As Excel.Application
        Dim exBook As Excel.Workbook
        Dim exSheet As Excel.Worksheet
        Const exdown = -4121
        
        Set exApp = GetObject(, "Excel.Application")
    
        'Open the workbook
        Set exBook = exApp.ActiveWorkbook
        
        exApp.Visible = True
        
        exApp.Interactive = False
    
        'Instantiate the exSheet object to the specific work sheet you want to play with
        Set exSheet = exBook.Worksheets("Sheet1")
        
        exSheet.Activate
        
        If Not rs3.EOF Then
           With exSheet.Range("A1").End(xlDown).Offset(1,0) 
    .CopyFromRecordset rs3
            End With
        End If
        
        
        
        rs3.Close
        Set rs3 = Nothing
        
        Set exSheet = Nothing
        Set exBook = Nothing
        Set exApp = Nothing

  6. #6
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Ok - that's better thanks. But this still isn't all the code. Are these two seperate, descrete functions? Because in your first post it is a single code block. Also, I can't see the evil "on error resum next" this time - is it omitted from what you copied and pasted or is it now removed from the code?

    I suspect this isn't a problem with Excel at all but can't be sure - could you just post the whole lot please?
    Testimonial:
    pootle flump
    ur codings are working excelent.

  7. #7
    Join Date
    Jan 2008
    Posts
    37
    Yes they are two separate functions with other stuff going on. I remove the on error resume next line. So here's what i have exactly:

    Code:
    Public Function nursing()
        Dim db As Database
        Dim strsql As String
        Dim strsql2 As String
        Dim strsql3 As String
        Dim rs As Recordset
        Dim rs2 As Recordset
        Dim rs3 As Recordset
        Dim course As String
        Dim fac As Integer
        Dim id As Variant
        
        
            
        Set db = CurrentDb()
        
        'Puts the Incoming Students doing nursing into the working table
        strsql = "Insert into tblWorking ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_STANDING ) "
        strsql = strsql & "Select tblIncoming.STU_ID, tblIncoming.STU_FORENAME, tblIncoming.STU_SURNAME, tblIncoming.STU_COURSE_CODE, tblIncoming.STU_STANDING "
        strsql = strsql & "From [tblIncoming] "
        strsql = strsql & "Where [tblIncoming].STU_COURSE_CODE = 'TR091' or [tblIncoming].STU_COURSE_CODE = 'TR092' or [tblIncoming].STU_COURSE_CODE = 'TR093' or [tblIncoming].STU_COURSE_CODE = 'TR094' or [tblIncoming].STU_COURSE_CODE = 'TR095' or [tblIncoming].STU_COURSE_CODE = 'TR096' or [tblIncoming].STU_COURSE_CODE = 'TR097' or [tblIncoming].STU_COURSE_CODE = 'TR098' or [tblIncoming].STU_COURSE_CODE = 'TR911' or [tblIncoming].STU_COURSE_CODE = 'TR912' or [tblIncoming].STU_COURSE_CODE = 'TR913' or [tblIncoming].STU_COURSE_CODE = 'TR914'  "
        db.Execute (strsql)
        
       'Deletes the Incoming Students doing nursing from the Incoming Table
        strsql = "Delete from tblIncoming "
        strsql = strsql & "Where tblIncoming.[STU_COURSE_CODE] = 'TR091' or [tblIncoming].STU_COURSE_CODE = 'TR092' or [tblIncoming].STU_COURSE_CODE = 'TR093' or [tblIncoming].STU_COURSE_CODE = 'TR094' or [tblIncoming].STU_COURSE_CODE = 'TR095' or [tblIncoming].STU_COURSE_CODE = 'TR096' or [tblIncoming].STU_COURSE_CODE = 'TR097' or [tblIncoming].STU_COURSE_CODE = 'TR098' or [tblIncoming].STU_COURSE_CODE = 'TR911' or [tblIncoming].STU_COURSE_CODE = 'TR912' or [tblIncoming].STU_COURSE_CODE = 'TR913' or [tblIncoming].STU_COURSE_CODE = 'TR914' "
        db.Execute (strsql)
    
        'Makes a recordset of all Incoming nursing Students
        strsql2 = "Select * From tblWorking "
        Set rs = db.OpenRecordset(strsql2)
        
        
        With rs
            Do While Not .EOF   'Loop through the nursing students
            
            course = rs("STU_COURSE_CODE") 'Get the students course
            fac = DLookup("[CS_FAC_NO]", "tblCourse", "CS_CODE = '" & course & "'")
            
            
            'Selects the first tutor in the nursing department with free space
            strsql3 = "SELECT TOP 1 tblTutor.TU_CODE " _
                    & "FROM tblTutor LEFT JOIN [tblStudents] ON [tblTutor].TU_CODE = [tblStudents].STU_TU_CODE " _
                    & "GROUP BY tblTutor.TU_CODE, tblTutor.TU_CHAMBER_SIZE, tblTutor.TU_DP_NO, tblStudents.STU_TU_CODE " _
                    & "HAVING ([TU_CHAMBER_SIZE] > (Count([tblStudents].STU_TU_CODE)) AND (tblTutor.TU_DP_NO = 57) )"
            
            Set rs2 = db.OpenRecordset(strsql3)
            
          
            If rs2.RecordCount <> 0 Then  'Assigns the student to this tutor
                rs.Edit
                rs!STU_TU_CODE = rs2!TU_CODE
                rs.Update
            End If
            
            id = rs("STU_ID")
            
            If DLookup("STU_ID", "tblStudents", "STU_ID =" & id) Then  'found student details
                strsql = "Delete from tblStudents where tblStudents.STU_ID =" & id
                db.Execute (strsql)
                strsql = "Insert into [tblStudents] ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_FAC_NO, STU_STANDING, STU_TU_CODE ) " _
                    & "Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_COURSE_CODE, " & fac & ", [tblWorking].STU_STANDING, [tblWorking].STU_TU_CODE " _
                    & "From [tblWorking] " _
                    & "Where tblWorking.STU_TU_CODE is not null "
                db.Execute (strsql)
            Else 'haven't found the student details
                strsql = "Insert into [tblStudents] ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_FAC_NO, STU_STANDING, STU_TU_CODE ) " _
                    & "Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_COURSE_CODE, " & fac & ", [tblWorking].STU_STANDING, [tblWorking].STU_TU_CODE " _
                    & "From [tblWorking] " _
                    & "Where tblWorking.STU_TU_CODE is not null "
                 
                db.Execute (strsql)
            End If
                       
            rs.MoveNext 'Move to the next student
            
            Loop
            
        End With
               
        Set rs3 = db.OpenRecordset("Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_TU_CODE From [tblWorking] Where tblWorking.STU_TU_CODE is not null ")
                    
        Dim exApp As Excel.Application
        Dim exBook As Excel.Workbook
        Dim exSheet As Excel.Worksheet
        Set exApp = New Excel.Application
    
        'Open the workbook
        Set exBook = exApp.Workbooks.add
        
        exApp.Visible = True
        
        exApp.Interactive = False
    
        'Instantiate the exSheet object to the specific work sheet you want to play with
        Set exSheet = exBook.Worksheets("Sheet1")
        
        exSheet.Activate
        
        If Not rs3.EOF Then
            exSheet.Range("A1").CopyFromRecordset rs3
        End If
        
        rs3.Close
        Set rs3 = Nothing
        
        Set exSheet = Nothing
        Set exBook = Nothing
        Set exApp = Nothing
        
        
        'Delete the assigned students from the Working table
        strsql = "Delete from tblWorking Where tblWorking.STU_TU_CODE is not null"
        db.Execute (strsql)
        
        'If there are any unassigned students put them back in the Incoming table
        strsql = "Insert into tblIncoming ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_STANDING ) "
        strsql = strsql & "Select tblWorking.STU_ID, tblWorking.STU_FORENAME, tblWorking.STU_SURNAME, tblWorking.STU_COURSE_CODE, tblWorking.STU_STANDING "
        strsql = strsql & "From [tblWorking] "
        db.Execute (strsql)
        
        'And delete from Working table
        strsql = "Delete from tblWorking"
        db.Execute (strsql)
        
         
    End Function
    Have to put the second function in another post as it is too long!
    Last edited by pootle flump; 03-04-08 at 07:42. Reason: Added code tags. Tsk

  8. #8
    Join Date
    Jan 2008
    Posts
    37
    Code:
    Public Function law()
        Dim db As Database
        Dim strsql As String
        Dim strsql2 As String
        Dim strsql3 As String
        Dim rs As Recordset
        Dim rs2 As Recordset
        Dim course As String
        Dim fac As Integer
        Dim rs3 As Recordset
        Dim exist As String
        Dim id As Variant
        
        Set db = CurrentDb()
        
        'Puts the Incoming Students doing law into the working table
        strsql = "Insert into tblWorking ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_STANDING ) "
        strsql = strsql & "Select tblIncoming.STU_ID, tblIncoming.STU_FORENAME, tblIncoming.STU_SURNAME, tblIncoming.STU_COURSE_CODE, tblIncoming.STU_STANDING "
        strsql = strsql & "From [tblIncoming] "
        strsql = strsql & "Where [tblIncoming].STU_COURSE_CODE = 'TR004' or [tblIncoming].STU_COURSE_CODE = 'TR018' or [tblIncoming].STU_COURSE_CODE = 'TR019' "
        db.Execute (strsql)
        
       'Deletes the Incoming Students doing law from the Incoming Table
        strsql = "Delete from tblIncoming "
        strsql = strsql & "Where [tblIncoming].STU_COURSE_CODE = 'TR004' or [tblIncoming].STU_COURSE_CODE = 'TR018' or [tblIncoming].STU_COURSE_CODE = 'TR019' "
        db.Execute (strsql)
    
        'Makes a recordset of all Incoming law Students
        strsql2 = "Select * From tblWorking "
        Set rs = db.OpenRecordset(strsql2)
        
        
        With rs
            Do While Not .EOF   'Loop through the law students
            
            course = rs("STU_COURSE_CODE") 'Get the students course
            fac = DLookup("[CS_FAC_NO]", "tblCourse", "CS_CODE = '" & course & "'")
            
            'Selects the first tutor in the law department with free space
            strsql3 = "SELECT TOP 1 tblTutor.TU_CODE " _
                    & "FROM tblTutor LEFT JOIN [tblStudents] ON [tblTutor].TU_CODE = [tblStudents].STU_TU_CODE " _
                    & "GROUP BY tblTutor.TU_CODE, tblTutor.TU_CHAMBER_SIZE, tblTutor.TU_DP_NO, tblStudents.STU_TU_CODE " _
                    & "HAVING ([TU_CHAMBER_SIZE] > (Count([tblStudents].STU_TU_CODE)) AND (tblTutor.TU_DP_NO = 28) )"
            
            Set rs2 = db.OpenRecordset(strsql3)
            
          
            If rs2.RecordCount <> 0 Then  'Assigns the student to this tutor
                rs.Edit
                rs!STU_TU_CODE = rs2!TU_CODE
                rs.Update
            End If
            
            id = rs("STU_ID")
            
            If DLookup("STU_ID", "tblStudents", "STU_ID =" & id) Then  'found student details
                strsql = "Delete from tblStudents where tblStudents.STU_ID =" & id
                db.Execute (strsql)
                strsql = "Insert into [tblStudents] ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_FAC_NO, STU_STANDING, STU_TU_CODE ) " _
                    & "Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_COURSE_CODE, " & fac & ", [tblWorking].STU_STANDING, [tblWorking].STU_TU_CODE " _
                    & "From [tblWorking] " _
                    & "Where tblWorking.STU_TU_CODE is not null "
                db.Execute (strsql)
            Else 'haven't found the student details
                strsql = "Insert into [tblStudents] ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_FAC_NO, STU_STANDING, STU_TU_CODE ) " _
                    & "Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_COURSE_CODE, " & fac & ", [tblWorking].STU_STANDING, [tblWorking].STU_TU_CODE " _
                    & "From [tblWorking] " _
                    & "Where tblWorking.STU_TU_CODE is not null "
                 
                db.Execute (strsql)
            End If
            
                       
            .MoveNext 'Move to the next student
            
            Loop
            
        End With
        
        Set rs3 = db.OpenRecordset("Select [tblWorking].STU_ID, [tblWorking].STU_FORENAME, [tblWorking].STU_SURNAME, [tblWorking].STU_TU_CODE From [tblWorking] Where tblWorking.STU_TU_CODE is not null ")
                    
        Dim exApp As Excel.Application
        Dim exBook As Excel.Workbook
        Dim exSheet As Excel.Worksheet
        Const xldown = -4121
        
        Set exApp = GetObject(, "Excel.Application")
    
        'Open the workbook
        Set exBook = exApp.ActiveWorkbook
        
        exApp.Visible = True
        
        exApp.Interactive = False
    
        'Instantiate the exSheet object to the specific work sheet you want to play with
        Set exSheet = exBook.Worksheets("Sheet1")
        
        exSheet.Activate
        
        If Not rs3.EOF Then
            exSheet.Range("A1").Offset(1, 0).End(xldown).CopyFromRecordset rs3
            
        End If
        
        
        
        rs3.Close
        Set rs3 = Nothing
        
        Set exSheet = Nothing
        Set exBook = Nothing
        Set exApp = Nothing
        
        'Delete the assigned students from the Working table
        strsql = "Delete from tblWorking Where tblWorking.STU_TU_CODE is not null"
        db.Execute (strsql)
        
        'If there are any unassigned students put them back in the Incoming table
        strsql = "Insert into tblIncoming ( STU_ID, STU_FORENAME, STU_SURNAME, STU_COURSE_CODE, STU_STANDING ) "
        strsql = strsql & "Select tblWorking.STU_ID, tblWorking.STU_FORENAME, tblWorking.STU_SURNAME, tblWorking.STU_COURSE_CODE, tblWorking.STU_STANDING "
        strsql = strsql & "From [tblWorking] "
        db.Execute (strsql)
        
        'And delete from Working table
        strsql = "Delete from tblWorking"
        db.Execute (strsql)
        
           
    End Function
    And here's what i have that calls these functions one after the other:

    Code:
    Public Sub alloc()
    
    Dim msg As String
    
    nursing
    law
    
    msg = MsgBox("Allocation Complete", , "Complete")
    End Sub
    Its probably something silly im missing - any ideas?
    Last edited by pootle flump; 03-04-08 at 07:43. Reason: Added code tags. Tsk

  9. #9
    Join Date
    Jan 2008
    Posts
    37
    Sorry to be a pain but this is still causing me difficulties and it's one of the last things i have to do. Ive been messing around with it to no avail, dont suppose there are any more suggestions?

  10. #10
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Sorry - this is not immediately obvious and I need some testing time. I'll try to look over the we or lunch if I'm lucky.
    Testimonial:
    pootle flump
    ur codings are working excelent.

  11. #11
    Join Date
    Jan 2007
    Location
    UK
    Posts
    11,434
    Provided Answers: 10
    Your too good Poots
    George
    Home | Blog

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •