Private Sub Auditor_Click()
On Error GoTo Err_Auditor_Click
Dim strReps As String
Dim strReps2 As String
Dim update As String
Dim rstReps As New ADODB.Recordset
Dim rstRepsOut As New ADODB.Recordset
Dim test As Recordset
Dim db As Database
Dim qry As QueryDef
Dim qry2 As QueryDef
Dim i As Long
Dim FileName As String
If Me!List6.ItemsSelected.Count = 0 Then
MsgBox "You must select Software.", vbCritical, "No records selected."
GoTo Exit_Auditor_Click
End If
Set CnLoad = CurrentProject.Connection
rstSoftware.Open "Software", CnLoad, _
adOpenKeyset, adLockOptimistic, adCmdTable
For Each varSelRecord In Me!List6.ItemsSelected
lngSWIndexOI = CLng(Me!List6.ItemData(varSelRecord))
strTarget = "Index = " & CStr(lngSWIndexOI)
rstSoftware.Find strTarget
strSoftwareNameOI = rstSoftware("Software Name")
strVersionOI = rstSoftware("Version")
strOSOI = rstSoftware("Operating System")
FileName = strSoftwareNameOI
'MsgBox strSoftwareNameOI + " " + strVersionOI + " " + strOSOI
strReps = "SELECT Software.[Software Name], Software.Version, Software.[Operating System], " & _
"Software.Status, Software.[Status Date], Software.[Approved Platforms], " & _
"Software.[Code Type], CUsage.[Cost Center], CUsage.[Entered On] " & _
"FROM Software INNER JOIN CUsage " & _
"ON Software.[Software Name] = CUsage.[Software Name] " & _
"AND Software.Version = CUsage.Version " & _
"AND Software.[Operating System] = CUsage.[Operating System] " & _
"WHERE Software.[Software Name] = '" & strSoftwareNameOI & "' " & _
"AND Software.Version = '" & strVersionOI & "' " & _
"AND Software.[Operating System] = '" & strOSOI & "'"
strReps2 = "SELECT Software.[Software Name], Software.Version, Software.[Operating System], " & _
"Software.Status, Software.[Status Date], Software.[Approved Platforms], " & _
"Software.[Code Type], Space(30) AS [Cost Center], Space(30) AS [Entered On] " & _
"FROM Software " & _
"WHERE Software.[Software Name] = '" & strSoftwareNameOI & "' " & _
"AND Software.Version = '" & strVersionOI & "' " & _
"AND Software.[Operating System] = '" & strOSOI & "'"
DBEngine.BeginTrans
Set db = CurrentDb()
On Error Resume Next
db.QueryDefs.Delete strSoftwareNameOI
Set qry = db.CreateQueryDef(strSoftwareNameOI, strReps)
CurrentDb.QueryDefs.Refresh
DBEngine.CommitTrans
If DCount("*", strSoftwareNameOI) = 0 Then
DBEngine.BeginTrans
Set db = CurrentDb()
On Error Resume Next
db.QueryDefs.Delete strSoftwareNameOI
Set qry2 = db.CreateQueryDef(strSoftwareNameOI, strReps2)
CurrentDb.QueryDefs.Refresh
DBEngine.CommitTrans
'DoCmd.OutputTo acOutputQuery, strSoftwareNameOI, acFormatXLS, strSoftwareNameOI & "_" & strVersionOI & "_" & strOSOI & ".xls", True ' Works Perfect
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "strSoftwareNameOI", "C:\testing.xls", True, strSoftwareNameOI & "_" & strVersionOI & "_" & strOSOI 'Crashes Access everytime
Else
'DoCmd.OutputTo acOutputQuery, strSoftwareNameOI, acFormatXLS, strSoftwareNameOI & "_" & strVersionOI & "_" & strOSOI & ".xls", True 'Works Perfect
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "strSoftwareNameOI", "C:\testing.xls", True, strSoftwareNameOI & "_" & strVersionOI & "_" & strOSOI 'Crashes Access everytime
End If
Next
rstSoftware.Close
Set rstSoftware = Nothing
Set CnLoad = Nothing
Exit_Auditor_Click:
Exit Sub
Err_Auditor_Click:
MsgBox Err.Description
Resume Exit_Auditor_Click
End Sub