Reputation: 1696
I'm opening excel workbook from access, after writing contents from access to excel, i'm using xlobj.save to save the workbook. Excel application is giving some warnings says this workbook already exists do u want to replace it. How to disable such warnings from access.
I'm using DoCmd.SetWarnings off but not working.
Here is my code
Public Sub sCopyResultstoexcel(conSHT_NAME As Variant, conWKB_NAME As Variant,
qrytable As String)
'Copy records to first 20000 rows
'in an existing Excel Workbook and worksheet
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim rs_Attribute As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset(qrytable, dbOpenSnapshot)
With objXL
.Visible = True
DoCmd.SetWarnings off
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Cells.ClearContents
DoCmd.SetWarnings off
.Range(.Cells(2, 1), .Cells(conMAX_ROWS, _
intLastCol)).CopyFromRecordset rs
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).WrapText = False
'Formatting
With objSht.Range("A1:CP1")
.HorizontalAlignment = xlCenter
.ColumnWidth = "8"
.Font.Italic = False
.Font.Bold = True
.EntireColumn.ColumnWidth = 15
End With
'Adding fields
With rs
For i = 1 To .Fields.Count
objSht.Cells(1, i) = .Fields(i - 1).Name
Next i
DoCmd.SetWarnings off
objWkb.Save
End With
End With
End With
'objWkb.Close
'objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Upvotes: 1
Views: 9146
Reputation: 123
I have had similar issues with trying to open read only / already open workbooks with VBA.
after your line:
Set objXL = New Excel.Application
add
objXL.DisplayAlerts = False
objXL.AskToUpdateLinks = False
objXL.EnableEvents = False
To get around saving over existing documents, you can save it somewhere temporarily, and then force copy it. Kind of brutish, but works...
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile SourceFile, DestinationFile, True
FSO.DeleteFile SourceFile
where SourceFile and DestinationFile are paths with file names.
Upvotes: 3
Reputation: 931
Upvotes: 0