Autostore Password for Export from Access query to excel spreadsheet.

**ADezii** · May 22 '07, 04:26 PM

Originally posted by 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

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** · May 24 '07, 08:57 PM

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

**ADezii** · May 24 '07, 11:13 PM

Originally posted by tasmontique

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

Post the code you are using to Export.

**tasmontique** · May 25 '07, 07:14 PM

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** · May 26 '07, 12:09 AM

Originally posted by 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.

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** · May 31 '07, 04:05 PM

Originally posted by ADezii

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** · May 31 '07, 11:33 PM

Originally posted by tasmontique

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.
[CODE=vb]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)

'To UNPROTECT the Worksheet prior to writing data
excelsheet.Unpr otect Password:= "password in quotes"

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

'To RE-PROTECT the Worksheet after writing data but before Save
excelsheet.Prot ect Password:= "password in quotes"

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[/CODE]