I am trying to export a query held within a table as T-SQL out to excel.
The idea is to have admins write the Queries, which will be exported by other personnel.
The View and Table do create correctly as I can see them within ssms, however I get a runtime error 7874 - cannot find object.
The only thing i can think of is that access is lagging behind sql server, and the database window is not being refreshed.
This is an ADP file running on Access 2007 on a SQL Server 2008 Standard Server.
The idea is to have admins write the Queries, which will be exported by other personnel.
The View and Table do create correctly as I can see them within ssms, however I get a runtime error 7874 - cannot find object.
The only thing i can think of is that access is lagging behind sql server, and the database window is not being refreshed.
This is an ADP file running on Access 2007 on a SQL Server 2008 Standard Server.
Code:
DoCmd.SetWarnings Warningsoff
Dim strsql As String
Dim strsql2 As String
Dim strexport As String
Dim strexcel As String
Dim str As String
'set the name for the view and the exported file
strsql2 = Me.txtEXPName & " - " & ENVIRON("USERNAME") & DatePart("d", Date) & DatePart("m", Date) & DatePart("yyyy", Date)
strsql = Me.txtEXPName & ENVIRON("USERNAME")
strexport = Me.txtEXPName & " - " & DatePart("d", Date) & "-" & DatePart("m", Date) & "-" & DatePart("yyyy", Date)
strexcel = "C:\Business Support\Exports\" & Me.txtEXPName & " - " & DatePart("d", Date) & "-" & DatePart("m", Date) & "-" & DatePart("yyyy", Date) & ".xls"
'determine if the Folder exists
If FolderExists("C:\Business Support\Exports") = False Then
MkDir "C:\Business Support\Exports"
Else
End If
'determine if the output file already exists
If FileExists(strexcel) = True Then
MsgBox "The Output File " & strexcel & vbCrLf & "Already exists" & vbCrLf & vbCrLf & "Please rename or delete the file before proceeding", vbCritical, "File exists"
Exit Sub
Else
End If
'If the view exists on the server, delete it
CurrentProject.Connection.Execute "IF EXISTS (SELECT * FROM sys.views WHERE object_id = OBJECT_ID(N'[dbo].[" & strsql & "]')) DROP VIEW [dbo].[" & strsql & "]"
CurrentProject.Connection.Execute "IF EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].[" & strsql2 & "]')) DROP TABLE [dbo].[" & strsql2 & "]"
'Create view on the server
CurrentProject.Connection.Execute "CREATE VIEW " & strsql & " AS " & Me.txtExport & ""
CurrentProject.Connection.Execute "SELECT * INTO " & strsql2 & " FROM " & strsql & ""
CurrentProject.Application.RefreshDatabaseWindow
'Transfer the data to MS 2003 Compatible Excel File
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strsql2, strexcel, True
'delete the view from the server
CurrentProject.Connection.Execute "DROP VIEW " & strsql & ""
CurrentProject.Connection.Execute "DROP Table " & strsql2 & ""
CurrentProject.Application.RefreshDatabaseWindow
DoCmd.SetWarnings Warningson
MsgBox "Export Complete" & vbCrLf & vbCrLf & "File is located at the following location" & vbCrLf & strexcel & vbCrLf & vbCrLf & "Press OK to open the file", vbOKOnly, "Export Completed"
'open the excel application
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Set xlApp = New Excel.Application
With xlApp
Set xlWB = .Workbooks.Open(strexcel, , False)
.Visible = True
Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
ActiveWorkbook.Save
End With
Comment