Autostore Password for Export from Access query to excel spreadsheet.

[tasmontique]

Hi All,

I have finally succeeded in exporting to a preformated excel spreadsheet.
I have one tiny setback.

One of the sheets I am exporting to must be password protected.

When I do this and export I am prompted for the password.

This defeats the point.

Is there a way in access to autostore the password for an excel spreadsheet so that everytime it is exported the password is automatically passed to excel.

Thanks in Advance

[ADezii]

Hi All,

I have finally succeeded in exporting to a preformated excel spreadsheet.
I have one tiny setback.

One of the sheets I am exporting to must be password protected.

When I do this and export I am prompted for the password.

This defeats the point.

Is there a way in access to autostore the password for an excel spreadsheet so that everytime it is exported the password is automatically passed to excel.

Thanks in Advance

Are you using the TransferSpreadsheet Method for your Export? If so, there is no built-in provision for passing the Worksheet Password in the process.

[tasmontique]

I am exporting from a query in vba. I am not using transfer spreadsheet

[ADezii]

I am exporting from a query in vba. I am not using transfer spreadsheet

Post the code you are using to Export.

[tasmontique]

Here is the code below that I use to export to access.

Private Sub CreateMonthlyReport(rsschedulesrecords As DAO.Recordset, curday As String)

Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim savefilepath As String
Dim tempi As Integer

Set excelfile = excelapp.Workbooks.Open(CurrentProject.Path & "Template1.xls")
Set excelsheet = excelfile.Worksheets.Item(1)

excelsheet.Cells(4, 1) = "EFFECTIVE Fr:" & Format(txtStartDate, "mmmm-dd,YYYY") & _
"To:" & Format(txtEndDate, "mmmm-dd,YYYY")

excelsheet.Cells(5, 7) = DateTime.Now
excelsheet.Range("L13") = DateTime.Now

If Not (rsschedulesrecords.EOF) Then
tempi = 1
While Not rsschedulesrecords.EOF
excelsheet.Range("A9", "L9").Insert
excelsheet.Cells(9, 1) = tempi
excelsheet.Cells(9, 2) = Format(rsschedulesrecords.Fields(3).Value, "dd-mmm-yy")
excelsheet.Cells(9, 3) = Format(rsschedulesrecords.Fields(4).Value, "dd-mmm-yy")
excelsheet.Cells(9, 4) = curday
excelsheet.Cells(9, 5) = rsschedulesrecords.Fields(1).Value
excelsheet.Cells(9, 6) = rsschedulesrecords.Fields(2).Value
excelsheet.Cells(9, 7) = rsschedulesrecords.Fields(17).Value
excelsheet.Cells(9, 8) = rsschedulesrecords.Fields(20).Value
excelsheet.Cells(9, 9) = CStr(rsschedulesrecords.Fields(19).Value) & " - " & _
CStr(rsschedulesrecords.Fields(22).Value)
excelsheet.Cells(9, 10) = rsschedulesrecords.Fields(23).Value
excelsheet.Cells(9, 11) = rsschedulesrecords.Fields(24).Value
excelsheet.Cells(9, 12) = rsschedulesrecords.Fields(28).Value
rsschedulesrecords.MoveNext
tempi = tempi + 1
Wend
End If

savefilepath = "\" & curday & "_Report_On-" & CStr(Format(DateTime.Now, "dd_mmm_yyyy-hh_mm_ss")) & ".xls"
excelfile.SaveAs CurrentProject.Path & savefilepath

excelapp.ActiveWorkbook.Close True, CurrentProject.Path & savefilepath
excelapp.Quit

Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing

End Sub

Here is the query I perform before exporting
Private Sub cmdExport_Click()
On Error GoTo FinalStep

Dim querystring As String
Dim dbase As DAO.Database
Dim rsSchedules As DAO.Recordset
Dim tempi As Integer
Dim rptcnt As Integer
rptcnt = 0


querystring = GetQueryString
If (Len(Trim(querystring)) > 0) Then
Set dbase = CurrentDb
If (Me.Optgroup.Value = OptMonthly.OptionValue) Then
MsgBox "Exporting monthly report for " & CStr(txtStartDate.Value) & _
" to " & CStr(txtEndDate.Value), vbExclamation, "Export"
tempi = 1

While tempi < 8
querystring = querystring & " AND " & GetWeekDay(tempi) & " = Yes "
Set rsSchedules = dbase.OpenRecordset(querystring)
If Not (rsSchedules.EOF = True) Then
CreateMonthlyReport rsSchedules, GetWeekDay(tempi)
rptcnt = rptcnt + 1
End If
rsSchedules.Close
tempi = tempi + 1
Wend
'I have ommitted some code here that applies to other reports

dbase.Close
If (rptcnt = 0) Then
MsgBox "No Repords Found for Excel Export", vbExclamation, "Export"
Else
MsgBox "Export to excel file(s) completed", vbExclamation, "Export Complete"
End If
Set rsSchedules = Nothing
Set dbase = Nothing
End If

I use the above code to export to excel. Initially Template1 was not password protected but when I password protected the template. I am prompted for a password right before MsgBox "Export To Excel completed" This defeats the point because I want the user to be able to export the information but only individuals with the password to open it.

Thanks helping.

[ADezii]

Here is the code below that I use to export to access.

Private Sub CreateMonthlyReport(rsschedulesrecords As DAO.Recordset, curday As String)

Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim savefilepath As String
Dim tempi As Integer

Set excelfile = excelapp.Workbooks.Open(CurrentProject.Path & "Template1.xls")
Set excelsheet = excelfile.Worksheets.Item(1)

excelsheet.Cells(4, 1) = "EFFECTIVE Fr:" & Format(txtStartDate, "mmmm-dd,YYYY") & _
"To:" & Format(txtEndDate, "mmmm-dd,YYYY")

excelsheet.Cells(5, 7) = DateTime.Now
excelsheet.Range("L13") = DateTime.Now

If Not (rsschedulesrecords.EOF) Then
tempi = 1
While Not rsschedulesrecords.EOF
excelsheet.Range("A9", "L9").Insert
excelsheet.Cells(9, 1) = tempi
excelsheet.Cells(9, 2) = Format(rsschedulesrecords.Fields(3).Value, "dd-mmm-yy")
excelsheet.Cells(9, 3) = Format(rsschedulesrecords.Fields(4).Value, "dd-mmm-yy")
excelsheet.Cells(9, 4) = curday
excelsheet.Cells(9, 5) = rsschedulesrecords.Fields(1).Value
excelsheet.Cells(9, 6) = rsschedulesrecords.Fields(2).Value
excelsheet.Cells(9, 7) = rsschedulesrecords.Fields(17).Value
excelsheet.Cells(9, 8) = rsschedulesrecords.Fields(20).Value
excelsheet.Cells(9, 9) = CStr(rsschedulesrecords.Fields(19).Value) & " - " & _
CStr(rsschedulesrecords.Fields(22).Value)
excelsheet.Cells(9, 10) = rsschedulesrecords.Fields(23).Value
excelsheet.Cells(9, 11) = rsschedulesrecords.Fields(24).Value
excelsheet.Cells(9, 12) = rsschedulesrecords.Fields(28).Value
rsschedulesrecords.MoveNext
tempi = tempi + 1
Wend
End If

savefilepath = "\" & curday & "_Report_On-" & CStr(Format(DateTime.Now, "dd_mmm_yyyy-hh_mm_ss")) & ".xls"
excelfile.SaveAs CurrentProject.Path & savefilepath

excelapp.ActiveWorkbook.Close True, CurrentProject.Path & savefilepath
excelapp.Quit

Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing

End Sub

Here is the query I perform before exporting
Private Sub cmdExport_Click()
On Error GoTo FinalStep

Dim querystring As String
Dim dbase As DAO.Database
Dim rsSchedules As DAO.Recordset
Dim tempi As Integer
Dim rptcnt As Integer
rptcnt = 0


querystring = GetQueryString
If (Len(Trim(querystring)) > 0) Then
Set dbase = CurrentDb
If (Me.Optgroup.Value = OptMonthly.OptionValue) Then
MsgBox "Exporting monthly report for " & CStr(txtStartDate.Value) & _
" to " & CStr(txtEndDate.Value), vbExclamation, "Export"
tempi = 1

While tempi < 8
querystring = querystring & " AND " & GetWeekDay(tempi) & " = Yes "
Set rsSchedules = dbase.OpenRecordset(querystring)
If Not (rsSchedules.EOF = True) Then
CreateMonthlyReport rsSchedules, GetWeekDay(tempi)
rptcnt = rptcnt + 1
End If
rsSchedules.Close
tempi = tempi + 1
Wend
'I have ommitted some code here that applies to other reports

dbase.Close
If (rptcnt = 0) Then
MsgBox "No Repords Found for Excel Export", vbExclamation, "Export"
Else
MsgBox "Export to excel file(s) completed", vbExclamation, "Export Complete"
End If
Set rsSchedules = Nothing
Set dbase = Nothing
End If

I use the above code to export to excel. Initially Template1 was not password protected but when I password protected the template. I am prompted for a password right before MsgBox "Export To Excel completed" This defeats the point because I want the user to be able to export the information but only individuals with the password to open it.

Thanks helping.

I am working on your dilemma, but as of yet have not come up with a viable solution. Be patient - I'll keep on trying.

[tasmontique]

I am working on your dilemma, but as of yet have not come up with a viable solution. Be patient - I'll keep on trying.

Thanks For Your Effort.

[ADezii]

Thanks For Your Effort.

The answer is so simple that it actually eluded me but here you go. Insert lines 13 and 44 exactly where indicated in your code. Lines 12 and 43 are Comments and are not necessary, though it may be a good idea to keep them in place. Let me know how you make out.

Private Sub CreateMonthlyReport(rsschedulesrecords As DAO.Recordset, curday As String)
 
Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
Dim savefilepath As String
Dim tempi As Integer
 
Set excelfile = excelapp.Workbooks.Open(CurrentProject.Path & "Template1.xls")
Set excelsheet = excelfile.Worksheets.Item(1)
 
'To UNPROTECT the Worksheet prior to writing data
excelsheet.Unprotect Password:= "password in quotes"
 
excelsheet.Cells(4, 1) = "EFFECTIVE Fr:" & Format(txtStartDate, "mmmm-dd,YYYY") & _
"To:" & Format(txtEndDate, "mmmm-dd,YYYY")
 
excelsheet.Cells(5, 7) = DateTime.Now
excelsheet.Range("L13") = DateTime.Now
 
If Not (rsschedulesrecords.EOF) Then
  tempi = 1
    While Not rsschedulesrecords.EOF
      excelsheet.Range("A9", "L9").Insert
      excelsheet.Cells(9, 1) = tempi
      excelsheet.Cells(9, 2) = Format(rsschedulesrecords.Fields(3).Value, "dd-mmm-yy")
      excelsheet.Cells(9, 3) = Format(rsschedulesrecords.Fields(4).Value, "dd-mmm-yy")
      excelsheet.Cells(9, 4) = curday
      excelsheet.Cells(9, 5) = rsschedulesrecords.Fields(1).Value
      excelsheet.Cells(9, 6) = rsschedulesrecords.Fields(2).Value
      excelsheet.Cells(9, 7) = rsschedulesrecords.Fields(17).Value
      excelsheet.Cells(9, 8) = rsschedulesrecords.Fields(20).Value
      excelsheet.Cells(9, 9) = CStr(rsschedulesrecords.Fields(19).Value) & " - " & _
CStr(rsschedulesrecords.Fields(22).Value)
      excelsheet.Cells(9, 10) = rsschedulesrecords.Fields(23).Value
      excelsheet.Cells(9, 11) = rsschedulesrecords.Fields(24).Value
      excelsheet.Cells(9, 12) = rsschedulesrecords.Fields(28).Value
      rsschedulesrecords.MoveNext
         tempi = tempi + 1
    Wend
End If
 
'To RE-PROTECT the Worksheet after writing data but before Save
excelsheet.Protect Password:= "password in quotes"
 
savefilepath = "\" & curday & "_Report_On-" & CStr(Format(DateTime.Now, "dd_mmm_yyyy-hh_mm_ss")) & ".xls"
excelfile.SaveAs CurrentProject.Path & savefilepath
 
excelapp.ActiveWorkbook.Close True, CurrentProject.Path & savefilepath
excelapp.Quit
 
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
 
End Sub