Page 1 of 2 12 LastLast
Results 1 to 15 of 21
  1. #1
    Join Date
    Oct 2005
    Posts
    183

    Unanswered: Getting an open excel spreadsheet through VBA

    Consider the below code. What I need to do, is access the spreadsheet after the OutputTo command has been run, and change the formatting of some fields. (Adding color etc)

    I can easily use createobject and do this, but I can't select/get an existing object and manipulate it from there... Help?


    Dim excelark As Object
    Dim Sikker As Integer

    Sikker = MsgBox("Er du sikker på du vil eksportere til Excel? Eksport funktionne tager lidt tid", vbYesNo)

    If Sikker = 6 Then
    DoCmd.OutputTo acOutputQuery, "Finalsheet", acFormatXLS, "test.xls", True
    Set excelark = GetObject(, Excel.Application.ActiveWorkbook)
    excelark.Application.cells(1, 1) = "BLAH BLAH"
    Else
    Exit Sub
    End If


    The above fails, and I must admit I am not quite sure how to manage it.

    Thanks in advance,

    Trin

  2. #2
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi

    Your code in the GetObject needs to be enclosed in double quotes. Not sure you want\ need the Active Workbook bit either.

    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  3. #3
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi

    Checked the code - yep - you can't return an active workbook like that. Check out the below - it uses early binding so is a better and quicker way of doing this. You will need to (in the VBA IDE) click Tools--> References and select Microsoft Excel x.0 Object Library. You can instantiate the various excel objects you might require:

    Code:
    	Dim excelark As Excel.Application
    	Dim exWB As Excel.Workbook
    	Dim exSheet As Excel.Worksheet
    	Dim Sikker As Integer
    	
    	Sikker = MsgBox("Er du sikker på du vil eksportere til Excel? Eksport funktionne tager lidt tid", vbYesNo)
    	
    	If Sikker = 6 Then
    		DoCmd.OutputTo acOutputQuery, "Finalsheet", acFormatXLS, "test.xls", True
    		
    		Set excelark = GetObject(, "Excel.Application")
    		
    		Set exWB = excelark.ActiveWorkbook
    		
    		Set exSheet = exWB.ActiveSheet
    		
    		exSheet.Cells(5, 1) = "BLAH BLAH"
    		
    	Else
    		Exit Sub
    	End If
    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  4. #4
    Join Date
    Oct 2005
    Posts
    183
    Thanks a bunch, I'll check it out ASAP.

  5. #5
    Join Date
    Oct 2005
    Posts
    183
    There still seems to be a problem referencing the already open spreadsheet.

    Setting the excelark application pointer to the in (DoCmd.OutputTo acOutputQuery, "Finalsheet", acFormatXLS, "test.xls", True) created excel spreadsheet fails.

    The getobject is apparently only meant to be a created object, so by some means - currently churning msdn - I have to return the object using another command than getobject.

    Any ideas would be great... otherwise I'll return with what I find in msdn.

    /trin

  6. #6
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi Trin

    GetObject returns the first open excel application. It fails if the application is not open.

    CreateObject (which has an early binding equivelent in the NEW keyword) instantiates a new instance of the application (in this case Excel).

    I didn't test the DoCmd.OutputTo bit (never used myself) - just tested on an open workbook. I presume this method opens the app as well?
    Testimonial:
    pootle flump
    ur codings are working excelent.

  7. #7
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Ok - I think I understand the problem.

    Excel is an out of process server or component. As such, it exectutes asynchronously to the code that calls it (i.e. independently in it's own memory space). As an out of process server it is also a little slow to get going. The GetObject command is executing before the Excel app is fully launched. You need something to pause the app or something similar until it has fully launched

    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  8. #8
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Low down and dirty proof that this is the case:

    Code:
    Sub getit2()
    	Dim excelark As Excel.Application
    	Dim exWB As Excel.Workbook
    	Dim exSheet As Excel.Worksheet
    	Dim Sikker As Integer
    	
    	Sikker = MsgBox("Er du sikker på du vil eksportere til Excel? Eksport funktionne tager lidt tid", vbYesNo)
    	
    	If Sikker = 6 Then
    		DoCmd.OutputTo acOutputQuery, "Finalsheet", acFormatXLS, "testXYZ.xls", True
    		
    		PauseApp (2)
    		
    		Set excelark = GetObject(, "Excel.Application")
    		
    		Set exWB = excelark.ActiveWorkbook
    		
    		Set exSheet = exWB.ActiveSheet
    		
    		exSheet.Cells(5, 1) = "BLAH BLAH"
    		
    	Else
    		Exit Sub
    	End If
    	
    End Sub
     
    Public Sub PauseApp(PauseInSeconds As Single)
    	
    	Dim sngStart As Single
    	
    	sngStart = Timer
    	
    	Do While sngStart + PauseInSeconds > Timer
    	Loop
    	
    End Sub
    Put in a delay of 2 seconds between running the OutputTo and the GetObject and the code works. I'm not suggesting this as the best method - merely that it proves the point and does do what you want it to. Perhaps, for example, you could set up a loop and exit it once the GetObject succeeds (putting in some sort of measure to make sure it doesn't go on forever if there is a problem).

    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  9. #9
    Join Date
    May 2004
    Posts
    65

    Another way

    Why don't you close the excel output file and reopen it - then complete your formatting.

  10. #10
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi Gavin

    The only way to close the spreadsheet (short of API calls) is to set a reference to it. The only way to do this is.... GetObject. Unless you have another way you are keeping close to your chest?

    Actually, another alternative (and the method I use to get data into excel) is to populate a recordset, instantiate an excel app and use the CopyFromRecordset method of the Excel range object. Since you instantiate the excel app there is no need for GetObject.
    Testimonial:
    pootle flump
    ur codings are working excelent.

  11. #11
    Join Date
    May 2004
    Posts
    65

    A fair bit of code

    I export information to excel like this:

    '************start of code
    Dim objXL As Object
    Dim objActiveWkb As Object
    Dim db As DAO.Database 'Might have to remove the DAO.
    Dim rs As DAO.Recordset 'Might have to remove the DAO.
    Dim Row As Integer
    Dim cnt As Integer
    Dim temptxt As String
    Dim temptxt2 As String
    Dim tempnum As Double

    Row = 3 'This is a counter for calculations

    Set objXL = CreateObject("Excel.Application")
    objXL.Visible = True
    objXL.Application.Workbooks.Add
    Set objActiveWkb = objXL.Application.ActiveWorkbook

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Students", dbOpenDynaset)

    With objActiveWkb
    '************ Create Worksheet Headings
    '.Worksheets(1).Cells(1, 3) = Text10
    .Worksheets(1).Cells(1, 1) = List4
    .Worksheets(1).Cells(2, 2) = "First Name"
    .Worksheets(1).Cells(2, 3) = "Last Name"
    .Worksheets(1).Cells(2, 5) = "Comment"

    '************** Deletes the 2 other sheets
    .Application.DisplayAlerts = False
    .Worksheets(3).delete
    .Worksheets(2).delete
    .Application.DisplayAlerts = True

    '************** Add students to worksheet
    While rs.EOF <> True
    If rs!Student_no <> 0 Then
    .Worksheets(1).Cells(Row, 1) = rs!Student_no
    .Worksheets(1).Cells(Row, 2) = rs!FirstName
    .Worksheets(1).Cells(Row, 3) = rs!LastName
    Row = Row + 1
    End If
    rs.MoveNext
    Wend
    '****** Hide Column A
    .Worksheets(1).Columns("A:A").Select
    .Worksheets(1).Columns("A:A").EntireColumn.Hidden = True
    .Worksheets(1).Rows("1:1").Select
    .Worksheets(1).Rows("1:1").EntireRow.Hidden = True
    '******** Set page size and fonts
    .Worksheets(1).PageSetup.Orientation = xlPortrait
    .Worksheets(1).PageSetup.PaperSize = xlPaperA4
    .Worksheets(1).PageSetup.LeftMargin = 40
    .Worksheets(1).PageSetup.RightMargin = 20
    .Worksheets(1).PageSetup.TopMargin = 60
    .Worksheets(1).PageSetup.BottomMargin = 20
    .Worksheets(1).Columns("A:G").Select
    .Worksheets(1).Columns("A:G").Font.Name = "Arial"
    .Worksheets(1).Columns("A:G").Font.Size = 12

    .Worksheets(1).Range("C1").Select
    .Worksheets(1).Range("C1").Font.Name = "Arial"
    .Worksheets(1).Range("C1").Font.Size = 14
    .Worksheets(1).Range("C1").Font.Bold = True
    .Worksheets(1).Range("B2:E2").Select
    .Worksheets(1).Range("B2:E2").Font.Bold = True

    '********* Create borders
    .Worksheets(1).Range("B2:E2").Select
    .Worksheets(1).Range("B2:E2").Borders(xlDiagonalDo wn).LineStyle = xlNone
    .Worksheets(1).Range("B2:E2").Borders(xlDiagonalUp ).LineStyle = xlNone
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeBottom )
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Worksheets(1).Range("B2:E2").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    .Worksheets(1).Range("B2:E2").Borders(xlInsideVert ical).LineStyle = xlNone
    With .Worksheets(1).Range("B2:E2").Interior
    .ColorIndex = 36
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With

    'Put box around
    With .Worksheets(1)
    temptxt = "B3:E" & Row - 1

    .Range(temptxt).Select
    .Range(temptxt).Borders(xlDiagonalDown).LineStyle = xlNone
    .Range(temptxt).Borders(xlDiagonalUp).LineStyle = xlNone
    With .Range(temptxt).Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With .Range(temptxt).Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    End With

    '********* Shade every second line
    cnt = 3
    While cnt <= Row - 1
    If (cnt / 2 - Int(cnt / 2)) * 10 <> 0 Then
    temptxt = "B" & cnt & ":E" & cnt
    '.Worksheets(1).Range(temptxt).Borders(xlInsideVer tical).LineStyle = xlNone
    With .Worksheets(1).Range(temptxt).Interior
    .ColorIndex = 35
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    End With
    End If

    cnt = cnt + 1
    Wend

    '***********Change Row Height
    With .Worksheets(1)
    .Rows("3:32").Select
    .Range("B3").Activate
    .Rows("3:" & Row).RowHeight = 23
    End With
    temptxt = "E3:E" & Row

    With .Worksheets(1).Range(temptxt)
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    With .Worksheets(1).Range(temptxt).Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    '******** Change column widths
    .Worksheets(1).Columns("D").ColumnWidth = 10
    .Worksheets(1).Columns("B:B").ColumnWidth = 15
    .Worksheets(1).Columns("C:C").ColumnWidth = 25
    .Worksheets(1).Columns("E:E").ColumnWidth = 40
    '********* End of code

    Although this seems a little messy, I normally record a macro in excel and then copy/paste into access visual basic code.

  12. #12
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi Gavin

    Yep - that's how I get data from access to excel too. In case it is of interest, I dropped my equivelent of:

    Code:
    If rs!Student_no <> 0 Then
    .Worksheets(1).Cells(Row, 1) = rs!Student_no
    .Worksheets(1).Cells(Row, 2) = rs!FirstName
    .Worksheets(1).Cells(Row, 3) = rs!LastName
    Row = Row + 1
    End If
    rs.MoveNext
    for

    Code:
     
    .Worksheets(1).Range("A3").CopyFromRecordset madoDataRst
    This copies the data to the spreadsheet in a single operation rather than a cell at a time. Why? Because it is scalable to any recordset size (subject to Excel's limitations of course). If you try to write a 20k deep 40 field wide recordset to a spreadsheet a cell at a time then you are in for a long wait - I know!

    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  13. #13
    Join Date
    Oct 2005
    Posts
    183
    The recordset I return is simply too huge to work with in ADO recordset fashion. I would be coding forever.

    I'lm giving the pause-thingy a go.

    Cheers, Trin

  14. #14
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Quote Originally Posted by Trinsan
    The recordset I return is simply too huge to work with in ADO recordset fashion. I would be coding forever.
    Really? That must be some recordset - I export 50K deep 40 field wide ADO recrodsets as part of my app - no probs. Your export can't be a massive order of magnitude beyond this surely - Excel can only handle 65K records.

    If you aren't comfy with ADO then we can help you with that - the fact is that the ability to use ADO will develop you as a programmer (career & technical) far more than using DoCmd (i.e. Access specific) methods.

    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

  15. #15
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    BTW - the code required to use recordsets is not proportional to the size of recordset (at least not in this context if you use the .CopyFromRecordset method) if that is what you mean.
    Testimonial:
    pootle flump
    ur codings are working excelent.

Posting Permissions

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