Consulting

Results 1 to 2 of 2

Thread: Export data from Access to Excel

  1. #1

    Export data from Access to Excel

    Hi,
    I'm trying to export data from a table in Access to separate excel workbooks based on a conditional field. The code I have below errors on Runtime Error 3022: the changes to the table you requested were not successful becuase they would cause duplicate values. I think this refers to the zExportQuery but there is no primary key there so I'm not sure they there is this error.

    Below is my code. Any help appreciated! Thanks.

    Sub MonthlyUtil()
    
    Dim qdf As DAO.QueryDef
    Dim dbs As DAO.Database
    Dim rstMgr As DAO.Recordset
    Dim strSQL As String, strTemp As String, strMgr As String
    
    Const strQName As String = "zExportQuery"
    
    Set dbs = CurrentDb
    
    ' Create temporary query that will be used for exporting data;
    ' we give it a dummy SQL statement initially (this name will
    ' be changed by the code to conform to each manager's identification)
    strTemp = dbs.TableDefs(0).Name
    strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
    Set qdf = dbs.CreateQueryDef(strQName, strSQL)
    qdf.Close
    strTemp = strQName
    
    ' *** code to set strSQL needs to be changed to conform to your
    ' *** database design -- ManagerID and EmployeesTable need to
    ' *** be changed to your table and field names
    ' Get list of ManagerID values -- note: replace my generic table and field names
    ' with the real names of the EmployeesTable table and the ManagerID field
    strSQL = "SELECT DISTINCT EntityID FROM qryMonthRep;"
    Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
    
    ' Now loop through list of ManagerID values and create a query for each ManagerID
    ' so that the data can be exported -- the code assumes that the actual names
    ' of the managers are in a lookup table -- again, replace generic names with
    ' real names of tables and fields
    If rstMgr.EOF = False And rstMgr.BOF = False Then
          rstMgr.MoveFirst
          Do While rstMgr.EOF = False
    
    ' *** code to set strMgr needs to be changed to conform to your
    ' *** database design -- ManagerNameField, ManagersTable, and
    ' *** ManagerID need to be changed to your table and field names
    ' *** be changed to your table and field names
                strMgr = DLookup("Entity", "Clients", _
            "EntityID = " & Chr(34) & rstMgr!EntityID.Value & Chr(34))
      
           ' *** code to set strSQL needs to be changed to conform to your
    ' *** database design -- ManagerID and EmployeesTable need to
    ' *** be changed to your table and field names
     
                strSQL = "SELECT * FROM qryMonthRep WHERE " & _
                      "EntityID = " & rstMgr!EntityID.Value & ";"
                Set qdf = dbs.QueryDefs(strTemp)
                qdf.Name = "q_" & strMgr
                strTemp = qdf.Name
                qdf.SQL = strSQL
                qdf.Close
                Set qdf = Nothing
    
    
      
                  
                                     
                    
    
            
    
    ' Replace C:\FolderName\ with actual path
    
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                      strTemp, "H:\SMART\HBG\Hospital Utilization\" & strMgr & Format(Now(), _
                      "ddMMMyyyy_hhnn") & ".xls"
    
                rstMgr.MoveNext
          Loop
    End If
    
    rstMgr.Close
    Set rstMgr = Nothing
    
    dbs.QueryDefs.Delete strTemp
    dbs.Close
    Set dbs = Nothing
    
    
    End Sub

  2. #2
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    I wouldn't actually be creating a new query for each manager. Untested, but try this:

    [vba]Sub MonthlyUtil()
    Dim qdf As DAO.QueryDef
    Dim dbs As DAO.Database
    Dim rstMgr As DAO.Recordset
    Dim strSQL As String, strMgr As String

    Set dbs = CurrentDb
    'NEW
    Set qdf = dbs.QueryDefs("zExportQuery")

    ' I don't think you need this section at all
    'strTemp = dbs.TableDefs(0).Name
    'strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
    'Set qdf = dbs.CreateQueryDef(strQName, strSQL)
    'qdf.Close
    'strTemp = strQName
    strSQL = "SELECT DISTINCT EntityID FROM qryMonthRep;"

    ' not changing any data, so open snapshot rather than dynaset
    Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
    Do While rstMgr.EOF = False
    strMgr = DLookup("Entity", "Clients", _
    "EntityID = " & Chr(34) & rstMgr!EntityID.Value & Chr(34))

    strSQL = "SELECT * FROM qryMonthRep WHERE " & _
    "EntityID = " & rstMgr!EntityID.Value & ";"

    qdf.SQL = strSQL
    ' changed to reference query name
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
    qdf.Name, "H:\SMART\HBG\Hospital Utilization\" & strMgr & Format(Now(), _
    "ddMMMyyyy_hhnn") & ".xls"
    rstMgr.MoveNext
    Loop
    rstMgr.Close
    qdf.Close
    dbs.Close
    Set rstMgr = Nothing
    Set dbs = Nothing
    Set qdf = Nothing
    End Sub
    [/vba]

    We are what we repeatedly do. Excellence, therefore, is not an act but a habit.
    Aristotle

Posting Permissions

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