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 TransferSpreads heet 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 CreateMonthlyRe port(rsschedule srecords As DAO.Recordset, curday As String)

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

Set excelfile = excelapp.Workbo oks.Open(Curren tProject.Path & "Template1.xls" )
Set excelsheet = excelfile.Works heets.Item(1)

excelsheet.Cell s(4, 1) = "EFFECTIVE Fr:" & Format(txtStart Date, "mmmm-dd,YYYY") & _
"To:" & Format(txtEndDa te, "mmmm-dd,YYYY")

excelsheet.Cell s(5, 7) = DateTime.Now
excelsheet.Rang e("L13") = DateTime.Now

If Not (rsschedulesrec ords.EOF) Then
tempi = 1
While Not rsschedulesreco rds.EOF
excelsheet.Rang e("A9", "L9").Inser t
excelsheet.Cell s(9, 1) = tempi
excelsheet.Cell s(9, 2) = Format(rsschedu lesrecords.Fiel ds(3).Value, "dd-mmm-yy")
excelsheet.Cell s(9, 3) = Format(rsschedu lesrecords.Fiel ds(4).Value, "dd-mmm-yy")
excelsheet.Cell s(9, 4) = curday
excelsheet.Cell s(9, 5) = rsschedulesreco rds.Fields(1).V alue
excelsheet.Cell s(9, 6) = rsschedulesreco rds.Fields(2).V alue
excelsheet.Cell s(9, 7) = rsschedulesreco rds.Fields(17). Value
excelsheet.Cell s(9, 8) = rsschedulesreco rds.Fields(20). Value
excelsheet.Cell s(9, 9) = CStr(rsschedule srecords.Fields (19).Value) & " - " & _
CStr(rsschedule srecords.Fields (22).Value)
excelsheet.Cell s(9, 10) = rsschedulesreco rds.Fields(23). Value
excelsheet.Cell s(9, 11) = rsschedulesreco rds.Fields(24). Value
excelsheet.Cell s(9, 12) = rsschedulesreco rds.Fields(28). Value
rsschedulesreco rds.MoveNext
tempi = tempi + 1
Wend
End If

savefilepath = "\" & curday & "_Report_On-" & CStr(Format(Dat eTime.Now, "dd_mmm_yyy y-hh_mm_ss")) & ".xls"
excelfile.SaveA s CurrentProject. Path & savefilepath

excelapp.Active Workbook.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(query string)) > 0) Then
Set dbase = CurrentDb
If (Me.Optgroup.Va lue = OptMonthly.Opti onValue) Then
MsgBox "Exporting monthly report for " & CStr(txtStartDa te.Value) & _
" to " & CStr(txtEndDate .Value), vbExclamation, "Export"
tempi = 1

While tempi < 8
querystring = querystring & " AND " & GetWeekDay(temp i) & " = Yes "
Set rsSchedules = dbase.OpenRecor dset(querystrin g)
If Not (rsSchedules.EO F = True) Then
CreateMonthlyRe port rsSchedules, GetWeekDay(temp i)
rptcnt = rptcnt + 1
End If
rsSchedules.Clo se
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 CreateMonthlyRe port(rsschedule srecords As DAO.Recordset, curday As String)

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

Set excelfile = excelapp.Workbo oks.Open(Curren tProject.Path & "Template1.xls" )
Set excelsheet = excelfile.Works heets.Item(1)

excelsheet.Cell s(4, 1) = "EFFECTIVE Fr:" & Format(txtStart Date, "mmmm-dd,YYYY") & _
"To:" & Format(txtEndDa te, "mmmm-dd,YYYY")

excelsheet.Cell s(5, 7) = DateTime.Now
excelsheet.Rang e("L13") = DateTime.Now

If Not (rsschedulesrec ords.EOF) Then
tempi = 1
While Not rsschedulesreco rds.EOF
excelsheet.Rang e("A9", "L9").Inser t
excelsheet.Cell s(9, 1) = tempi
excelsheet.Cell s(9, 2) = Format(rsschedu lesrecords.Fiel ds(3).Value, "dd-mmm-yy")
excelsheet.Cell s(9, 3) = Format(rsschedu lesrecords.Fiel ds(4).Value, "dd-mmm-yy")
excelsheet.Cell s(9, 4) = curday
excelsheet.Cell s(9, 5) = rsschedulesreco rds.Fields(1).V alue
excelsheet.Cell s(9, 6) = rsschedulesreco rds.Fields(2).V alue
excelsheet.Cell s(9, 7) = rsschedulesreco rds.Fields(17). Value
excelsheet.Cell s(9, 8) = rsschedulesreco rds.Fields(20). Value
excelsheet.Cell s(9, 9) = CStr(rsschedule srecords.Fields (19).Value) & " - " & _
CStr(rsschedule srecords.Fields (22).Value)
excelsheet.Cell s(9, 10) = rsschedulesreco rds.Fields(23). Value
excelsheet.Cell s(9, 11) = rsschedulesreco rds.Fields(24). Value
excelsheet.Cell s(9, 12) = rsschedulesreco rds.Fields(28). Value
rsschedulesreco rds.MoveNext
tempi = tempi + 1
Wend
End If

savefilepath = "\" & curday & "_Report_On-" & CStr(Format(Dat eTime.Now, "dd_mmm_yyy y-hh_mm_ss")) & ".xls"
excelfile.SaveA s CurrentProject. Path & savefilepath

excelapp.Active Workbook.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(query string)) > 0) Then
Set dbase = CurrentDb
If (Me.Optgroup.Va lue = OptMonthly.Opti onValue) Then
MsgBox "Exporting monthly report for " & CStr(txtStartDa te.Value) & _
" to " & CStr(txtEndDate .Value), vbExclamation, "Export"
tempi = 1

While tempi < 8
querystring = querystring & " AND " & GetWeekDay(temp i) & " = Yes "
Set rsSchedules = dbase.OpenRecor dset(querystrin g)
If Not (rsSchedules.EO F = True) Then
CreateMonthlyRe port rsSchedules, GetWeekDay(temp i)
rptcnt = rptcnt + 1
End If
rsSchedules.Clo se
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