Results 1 to 4 of 4
  1. #1
    Join Date
    Jun 2006
    Posts
    72

    Unanswered: Access query to excel

    I'm running Access 2002.

    I've got a form that creates a query and then loops through the data setting the cells of an excel spreadsheet to what is in the query. The good thing about this is when the user clicks generate it opens an instance of excel and the data is there for them to do with as they please rather than saving it then them having to find and open it. The bad thing is it is slow.

    I can use "DoCmd.OutputTo acQuery,..." to do essentially the same thing much faster but that requires a specific file location and name which I don't like.

    Is there any quick way to take a query and put it into an open instance of excel using VBA?

  2. #2
    Join Date
    Jan 2007
    Location
    UK
    Posts
    11,434
    Provided Answers: 10
    Does this do what you want?
    Code:
    DoCmd.OutputTo acOutputForm, "MyTable", acFormatXLS, , True
    In this case you still have to save the file, but the user gets to chose the location
    George
    Home | Blog

  3. #3
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Testimonial:
    pootle flump
    ur codings are working excelent.

  4. #4
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926
    Here's some code I use to update data in an existing excel sheet. It also uses LDAP. It's a little messy but it may give you a few ideas:
    Function hourdump()

    'current path to get xls file
    'Dim SDate, EDate As Date
    'SDate = Forms!Exportformhours!StartDate
    'EDate = Forms!Exportformhours!EndDate
    Dim txtfileName As String
    txtfileName = Forms!ExportFormHours!txtCustFilePath
    sfpath = txtfileName
    'sfpath = Application.CurrentProject.Path
    'sfpath = sfpath & "Terri's Documents\PR Allocation.xls"

    'errorlog excel worksheet
    errlogname = "errorlog"

    'errorlog excel worksheet cell increment
    errlogrow = 1

    'simple way to find if the today is BOM or EOM
    'If Format(Date, "d") < 16 Then
    tabactivate = Forms!ExportFormHours!TabName
    'Else
    ' tabactivate = "EOM-Hours"
    'End If

    'open excel object
    Set objApp = CreateObject("Excel.Application")

    'configure excel object settings
    With objApp

    .Visible = True

    .DisplayAlerts = False

    .Workbooks.Open FileName:=sfpath, UpdateLinks:=0

    'create a errorlog worksheet in the excel file
    'if exist delete and then create it
    On Error Resume Next
    .Sheets(errlogname).Delete
    On Error GoTo 0

    Set errlogsh = objApp.Worksheets.Add(, after:=.Worksheets(.Worksheets.Count))
    errlogsh.Name = errlogname
    Set errlogsh = Nothing

    .Sheets(errlogname).Columns("B:B").Select
    .selection.NumberFormat = "@"

    'choose the appropriate worksheet
    .Sheets(tabactivate).Activate

    End With

    'declare database connection objects
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    'sql statement
    strSQL = "Select * from ExcelHourDump"

    'get all records and fields from table
    rs.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic

    'go to the first record found
    rs.MoveFirst

    'loop through all records found
    Do While Not rs.EOF
    'troubleshooting - show current record values
    'MsgBox rs!LoginID & vbCrLf & rs!ProjCode & vbCrLf & rs!SumOfHours

    'convert login name to full name
    UserName = rs!LoginID

    'get current record sum hours and project code
    CurrentUserSOH = rs!SumOfHours

    Dim CurrentUserProjCode As Variant
    CurrentUserProjCode = rs!ProjCode

    'if there is a -CCCalcs suffix get rid of it
    'UserName = Trim(Replace(UserName, " - CCCalcs", ""))

    'Set User = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
    On Error Resume Next
    Set User = GetObject("LDAP://jerry/uid=" & UserName & ",ou=People,dc=weccusa,dc=org")

    'if the user does not exist in the ldap database, add it to the error log
    If err.Number <> 0 Then

    objApp.Sheets(errlogname).Cells(errlogrow, 1).Value = UserName & " could not be found in LDAP"
    objApp.Sheets(errlogname).Cells(errlogrow, 2).Value = CurrentUserProjCode
    objApp.Sheets(errlogname).Cells(errlogrow, 3).Value = CurrentUserSOH
    errlogrow = errlogrow + 1

    GoTo SkipUser:

    End If
    On Error GoTo 0

    UserFullName = User.cn
    UserSN = User.sn

    'regenerate name to be last name comma first name
    CurrentUserFullName = Trim(UserSN) & ", " & Trim(Replace(UserFullName, Trim(UserSN), ""))

    'do the following steps in the excel object
    With objApp

    'turn off error trapping
    On Error Resume Next

    'find and select the user row in the worksheet
    userretval = .Cells.Find(CurrentUserFullName).Select

    'find and get the row number
    UserFullNameRow = .Cells.Find(CurrentUserFullName).Row

    'find and get the project code col number
    ' ProjCodeCol = .Cells.search(CurrentUserProjCode).Column

    'Dim ProjCodeCol As Variant
    ProjCodeCol = .Cells.Find(CurrentUserProjCode, , , 1).Column

    ' ProjCodeCol = .Cells.Find(CurrentUserProjCode).Column
    ' ProjCodeCol = .Cells.Find(CurrentUserProjCode).Column

    ' ProjCodeCol = .Cells.Find(CurrentUserProjCode).Column
    If ProjCodeCol = 1 Then err.Number = 999

    'if there was any problem finding the username or project code
    'log it else if there is no error, change the user's hours
    If err.Number <> 0 Then
    '
    'MsgBox " error" & Err.Number
    .Sheets(errlogname).Cells(errlogrow, 1).Value = CurrentUserFullName
    .Sheets(errlogname).Cells(errlogrow, 2).Value = CurrentUserProjCode
    .Sheets(errlogname).Cells(errlogrow, 3).Value = CurrentUserSOH

    errlogrow = errlogrow + 1

    Else

    'modify the appropriate column for the user
    .Cells(UserFullNameRow, ProjCodeCol).Value = CurrentUserSOH

    End If

    'turn error trapping back on
    On Error GoTo 0

    End With

    'If there is an error come to here
    SkipUser:

    rs.MoveNext
    Loop

    rs.Close
    Set rs = Nothing

    'MsgBox "done"
    'objApp.Quit

    Set objsheet = Nothing
    Set objBook = Nothing
    Set objApp = Nothing


    End Function
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

Posting Permissions

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