CODEWITHSUNDEEP
excelms-accessvba
vuyy1182
vuyy1182

Reputation: 1696

How to set warnings off in excel application from access vba

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

Answers (2)

Casey Morter
Casey Morter

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

steveo40
steveo40

Reputation: 931

  1. Check to see if the file already exists (use the Dir command).
  2. If it does, delete it.
  3. Save your file.

Upvotes: 0

Related Questions