fetch some records from the databse and place it in an encrypted excel spreadsheet

[aman]

Hi guys

I want to copy n number of records from the database and place it in an encrypted excel spreadsheet. I have written the following code which works perfectly fine but it doesn't save the excelsheet with the password and display the message "do you want to overwrite the existing excelsheet" if its with the same name.

I want it to automatically overwrite it if the same speadsheet already exists and automatically save it with the password on.

strsql = "SELECT * FROM tblcustomer where Proj_No=" & J & ""
If DCount("Name", "MSysobjects", "Name='qrytemp' and type=5") > 0 Then
DoCmd.DeleteObject acQuery, "qrytemp"
End If
Set qdf = CurrentDb.CreateQueryDef("qrytemp", strsql)
    Dim objXls As Excel.Application
    Dim objWrkBk As Excel.Workbook
    Dim xprtFile As String
 
   xprtFile = "J:\Data_Quality_Team\Customer Tracing\Williams Lea\P" & J & ".xls"
    DoCmd.OutputTo acOutputQuery, "qrytemp", acFormatXLS, xprtFile, False
 
     Set objXls = New Excel.Application
     objXls.Visible = False
     Const xlLandscape = 2
     Set objWrkBk = objXls.Workbooks.Open(xprtFile)
 
        t = objWrkBk.ActiveSheet.UsedRange.Rows.Count
      With objWrkBk.Sheets("qrytemp")
           .Application.Rows("1:1").Select
       .Application.Selection.Font.Bold = True
        '.Quit
        End With
         With objWrkBk.Sheets("qrytemp").PageSetup
        .RightHeader = "Total Cases=" & t - 1
        .Orientation = xlLandscape
 
    End With
 
    Set objWrkBk = Nothing
    objXls.Quit
 
    Set objXls = Nothing
Set qdf = Nothing
End Sub

I hope anyone can help me out.

Thanks

 

[aman]

Can anyone please find solution to my problem?

Thanks