一、背景：
许多客户在使用系统时，可能需要大范围收集资料。但可能受限于每个客户并不是都能登录系统，如外部供应商，或只是临时性的需要填写数据并不能要求每个用户均安装客端。这时，离线模板的作用就开始生效了。
二、定义：
离线模板是指用户在填写数据时不需要登录现有系统，在普通EXCEL环境下就能填写，填写完毕，可以通过一定的技术手段将数据导入到系统中。
三、实现过程：
1、在系统中定义标准模板，并将模板单独另存为EXCEL文件。
2、通过公式引用 的方式，将模板中的表单数据转换为清单数据，并指定区域名称。
3、保护工作表相关区域，将文件分发给所有用户。用户填写数据，收回多个EXCEL文件。
4、缩写导入数据VBA代码，将多个EXCEL文件中的清单收集到另一个系统模板中。
四、参考代码：
Sub Import_data()
On Error Resume Next

Dim Fcount, Rcount As Long
''----------------------判断是否有数据
Worksheets("本周完成情况").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Worksheets("下周计划").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
''------------------------打开文件
Call openfile
''---------------------计算出总共有几个文件需要导入
Worksheets("参数").Activate
Worksheets("参数").Range("a1").Select
Worksheets("参数").Range("a1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Fcount = tbl.Rows.Count
''---------------------------开始循环导入数据文件
For I = 1 To Fcount
''---------------------------获取需要导入的文件名
Fname = Sheets("参数").Cells(I, 1)
''---------------------------计算并定位行号
Worksheets("本周完成情况").Activate
Range("A1").Select
Range("A1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Rcount = tbl.Rows.Count + 1
''－－－－－－－－－－－－－－－－－－－开始导入
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Fname & ";" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Cells(Rcount, 1))
.CommandType = xlCmdTable
.CommandText = Array("本周完成情况$")
.Name = "本周完成"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Fname
.Refresh BackgroundQuery:=False
End With

''--------将查询区域的字段名移除并刷新数据源没有标题行。
Cells(Rcount, 1).Select
With Selection.QueryTable
.FieldNames = False
End With
Selection.QueryTable.Refresh BackgroundQuery:=False

''----------导下周计划
Worksheets("下周计划").Activate
Range("A1").Select
Range("A1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Rcount = tbl.Rows.Count + 1
''－－－－－－－－－－－－－－－－－－－开始导入
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Fname & ";" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Cells(Rcount, 1))
.CommandType = xlCmdTable
.CommandText = Array("下周计划$")
.Name = "下周计划"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Fname
.Refresh BackgroundQuery:=False
End With
''--------将查询区域的字段名移除并刷新数据源没有标题行。
Cells(Rcount, 1).Select
With Selection.QueryTable
.FieldNames = False
End With
Selection.QueryTable.Refresh BackgroundQuery:=False

Next I
''设置已用区域边框线
Sheets("本周完成情况").Select
Call Set_borders
Sheets("下周计划").Select
Call Set_borders
Sheets("控制台").Select
Exit Sub
End Sub

Sub openfile()
Worksheets("参数").Select
Range("a1:a1000").Select
Selection.Delete
Dim lngCount As Long
'' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
'' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
Fname = .SelectedItems(lngCount)
Worksheets("参数").Cells(lngCount, 1) = Fname
Next lngCount
End With
End Sub

Sub Set_borders()
ActiveSheet.UsedRange.Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End Sub

如果你对以上话题有需求，又觉得代码太麻烦的话，请联系我们，我们有现成的工具可以跳过代码直接实现以上功能。