Results 1 to 6 of 6
  1. #1
    Join Date
    Dec 2006
    Posts
    39

    Unanswered: Access qry to Excel cells

    Here's what I have....

    I'm currently linked to a SQL db table, which exports the data to my Access table. What I need to accomplish for further automation is to have this data that is queried in Access, linked to a specific area in an Excel spreadsheet.
    The attachments show:

    Worksheet - This is where the data must be reflected (in real time, or when someone opens it)
    Access qry - where it's coming from.

    Does anyone have VB code to make this happen, where I can make minimal changes to cell reference or file names?

    I would be forever grateful.

    Thanks,

    B
    Attached Thumbnails Attached Thumbnails Worksheet.PNG   Access_qry.PNG  

  2. #2
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926
    Here's some code I used (sorry I haven't documented it better)

    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)

  3. #3
    Join Date
    Jun 2004
    Location
    Arizona, USA
    Posts
    1,848
    try this thread at xtremevb.com (a sister-site...)
    Lou
    使大吃一惊
    "Lisa, in this house, we obey the laws of thermodynamics!" - Homer Simpson
    "I have my standards. They may be low, but I have them!" - Bette Middler
    "It's a book about a Spanish guy named Manual. You should read it." - Dilbert


  4. #4
    Join Date
    Jan 2007
    Location
    UK
    Posts
    11,434
    Provided Answers: 10
    MllB, please do NOT cross post. This is the 3rd copy of this thread I have found.
    Post it once and if it is in the wrong place it will be moved.
    George
    Home | Blog

  5. #5
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926
    Some good info in that post loquin (wish I had it when I was designing my code.)
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

  6. #6
    Join Date
    Dec 2006
    Posts
    39

    Smile Thanks!

    Thanks for the help!
    Sorry for cross posting - I don't post too often and am unfamiliar with some of the dos and don'ts.

Posting Permissions

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