Using code to realize the method of collecting data from Excel off-line template

I. Background:

Many customers may need to collect data on a large scale when using the system. However, it may be limited to the fact that each customer is not able to log on to the system, such as external suppliers, or just temporary need to fill in the data and does not require each user to install the client side. At this point, the role of the offline template is now in effect.

Second, the definition:

Offline template refers to the user to fill in the data without the need to log in to the existing system, in the ordinary Excel environment can fill out, completed, you can through a certain technical means to import data into the system.

Third, the implementation process:

1, define the standard template in the system, and save the template separately as an Excel file.

2. The form data in the template is converted to the manifest data by means of a formula reference, and the name of the zone is specified.

3, protect the relevant areas of the worksheet, distribute the files to all users. The user fills in the data and reclaims multiple Excel files.

4, abbreviated import data VBA code, the list of multiple Excel files are collected into another system template.

Four, the reference code:

  Sub Import_data () on Error Resume Next Dim fcount, rcount as Long '----------------------to determine whether there is data worksheets ("This week Completion "). Activate Rows ("2:2"). Select Range (Selection, Selection.End (Xldown)). Select Selection.delete shift:=xlup Worksheets ("Plan for next week"). Activate Rows ("2:2"). Select Range (Selection, Selection.End (Xldown)).  
Select selection.delete shift:=xlup '------------------------Open file call OpenFile '---------------------calculates that there are a total of several files that need to be imported Worksheets ("parameters"). Activate Worksheets ("parameters"). Range ("A1"). Select Worksheets ("parameters"). Range ("A1"). Activate ActiveCell.CurrentRegion.Select Set tbl = activecell.currentregion Fcount = tbl. Rows.Count '---------------------------start looping through the data file for I = 1 to Fcount '---------------------------get the file name you want to import Fname = Sheets ("parameters"). Cells (I, 1) '---------------------------calculates and locates line number worksheets ("Complete this Week"). Activate Range ("A1"). Select Range ("A1"). Activate ActiveCell.CurrentRegion.Select Set tbl = activecell.currentregion Rcount = tbl. Rows.Count + 1 ' –-------------begins importing with ACTIVESHEET.QUERYTABLES.ADD (Connection:=array (_) OLE DB; 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 ("Completed this week $"). Name = "Done this week." 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 '--------Remove the field name from the query area and refresh the data source without a header row. Cells (Rcount, 1). Select with Selection.querytable. FieldNames = False End with Selection.QueryTable.Refresh backgroundquery:=false '----------Guide plan for next week worksheets ("Plan for next week"). Activate Range ("A1"). Select Range ("A1"). Activate ActiveCell.CurrentRegion.Select Set tbl = activecell.currentregion Rcount = tbl. Rows.Count + 1 '-------------------started importing with ACTIVESHEET.QUERYTABLES.ADD (Connection:=array (_) OLE DB; 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 ("plan $ next week"). Name = "Plan for next week". 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 '--------Remove the field name from the query area and refresh the data source without a header row. Cells (Rcount, 1). Select with Selection.querytable. FieldNames = False End With Selection.QueryTable.Refresh backgroundquery:=false Next I ' sets the used area border line Sheets ("This Week into the situation "). Select Call Set_borders Sheets ("Plan for next week"). Select Call Set_borders Sheets ("console"). Select Exit Sub End Sub Sub OpenFile () Worksheets ("parameters"). Select Range ("a1:a1000"). Select selection.delete Dim lngcount as Long ' Open the file dialog with Application.filedialog (msofil Edialogopen). AllowMultiSelect = True. Show ' Display paths of each of the file selected for lngcount = 1 to. Selecteditems.count Fname =. SelectedItems (LngcounT) Worksheets ("parameters"). Cells (lngcount, 1) = Fname Next Lngcount End and End Sub Sub Set_borders () ActiveSheet.UsedRange.Sel ECT 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 and End Sub