blammo04
06-11-2010, 06:02 AM
I am having some trouble with the docmd.transferspreadsheet function, everytime I run it, it crashes Access. I have used the docmd.outputto function and that works fine but I need the queries to be in the same excel file but in different sheet and the docmd.outputto open a new excel file for each query.
If someone could look at my code and the docmd.transferspreadsheet and see if anyone could help I would greatly appreciate it. Thanks.
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
I have tried to display an error message but Access just freezes and I get the program not responding message
Anybody have any suggestions????? I dont know what the problem is
If someone could look at my code and the docmd.transferspreadsheet and see if anyone could help I would greatly appreciate it. Thanks.
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
I have tried to display an error message but Access just freezes and I get the program not responding message
Anybody have any suggestions????? I dont know what the problem is