摘要：话说，最近几次我们都更新了与excel相关的功能，那今天我就再来更新一篇处理excel的文章，那我们就来看看具体的功能！

hi，大家好呀！

又到了一周一更新的日子了，这周我们来更新点啥呢？

话说，最近几次我们都更新了与excel相关的功能，那今天我就再来更新一篇处理excel的文章，那我们就来看看具体的功能！

在导出前，我们先要准备一个表，这次我们直接把之前用过的那张表T_Product，这张表我们在做导出时，添加合计行用过，如下图：

接着，我们来创建一个窗体，在窗体放上两个控件，一个文本框，一个按钮，如下图：

接着，我们就可以来添加代码了：

Private Sub btnExport_Click

On Error GoTo Err_ExportToExcel

Dim strName As String

Dim objExcel As Object

Dim objBook As Object

Dim objSheet As Object

Dim rst As Object

Dim objExcelQuery As Object

If IsNull(Me.txtPassWord) Then

MsgBox "请先输入密码！", vbCritical

Me.txtPassWord.SetFocus

Exit Sub

End If

strName = "产品.xlsx"

'使用文件对话框取得另存为的文件名

With Application.FileDialog(2) 'msoFileDialogSaveAs

.InitialFileName = strName

If .Show Then

strName = .SelectedItems(1)

If Not strName Like "*.xlsx" Then strName = strName & ".xlsx"

Else

strName = ""

End If

End With

If strName = "" Then Exit Sub

DoCmd.Hourglass True

Set objExcel = CreateObject("Excel.Application")

Set objBook = objExcel.Workbooks.Add

Set objSheet = objBook.Worksheets("sheet1")

Set rst = CurrentDb.OpenRecordset("T_Product")

Set objExcelQuery = objSheet.QueryTables.Add(rst, objSheet.Range("A1"))

With objExcelQuery

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

.Refresh BackgroundQuery:=False

End With

objExcelQuery.Refresh

rst.Close

objBook.Sheets("sheet1").Protect Password:=Me.txtPassWord '保护sheet表

objBook.Worksheets("sheet1").SaveAs strName

If MsgBox("数据已导出，是否打开并查看？", vbQuestion + vbYesNo) = vbYes Then

objExcel.Visible = True

Else

objBook.Saved = True

objExcel.Quit

End If

Exit_ExportToExcel:

Set objExcel = Nothing

Set objBook = Nothing

Set objSheet = Nothing

Set rst = Nothing

DoCmd.Hourglass False

Exit Sub

Err_ExportToExcel:

If Err = 70 Then

MsgBox "无法删除文件 '" & strName & "'，可能该文件已被打开或没有权限。", vbCritical

Else

MsgBox Err.Source & " #" & Err & vbCrLf & vbCrLf & Err.Description, vbCritical

End If

Resume Exit_ExportToExcel

End Sub

最后，就是运行测试了，我们来看一下效果。

在图中我们可以看到，导出后sheet1是有密码，如果直接修改是会有报错的，那说明我们成功了！

其实就是比我们导出的代码多了这一句，是不是非常的简单！

objBook.Sheets("sheet1").Protect Password:=Me.txtPassWord

好了，大家快去试一下吧！如果大家觉得我写的还行，不如给我一个小爱心吧，支持一下我！啵~~~

来源：韵韵课堂