VB-Access系统中实现Excel和Access数据库相互导入

2010.3Access，。[1].ASP.NET2.0.4，：，2006.[2].ASP.NET2.0（C#）.：，2008.(：2009-12-26）1，，“”，VisualBasic6.0+sp6、MicrosoftAccess2003MicrosoftExcel2003，VB+AccessExcelAccess。2“MicrosoftActiveXDataObjects2.6Library”“MicrosoftExcel11.0ObjectsLibrary'PublicfnAsString'AccessPublicfn1AsString'ExcelPublicfncountAsInteger'AccessPublicfn1countAsInteger'ExcelPublicconnAsNewADODB.Connection'mdbPubliccnAsNewADODB.Connection'xlsPublicSubmdbcon()'Accessconn.OpenProvider=Microsoft.Jet.OLEDB.4.0;DataSource=&fn&;PersistSecurityInfo=Falseconn.CursorLocation=adUseClient'EndSubPublicSubxlscon()'ExcelSetcn=NewADODB.ConnectionWithcn.Provider=Microsoft.Jet.OLEDB.4.0.ConnectionString=DataSource=&fn1&;&_ExtendedProperties=Excel8.0;.CursorLocation=adUseClient'.OpenEndWithEndSub3（option1、option2）1。：PrivateSubOption1_Click()fexcel.Show'Me.HideEndSubPrivateSubOption2_Click()outform.Show'Me.HideEndSubVB+AccessExcelAccess：“”，VB+AccessADOExcelAccess。：；VB+Access；ADO；VBExcel1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!392010.324（1）Excel，2。1）：（text1）；（img2）；（cd12）、（com1）；（dg1）Excel；（cmd1）。2）：PrivateSubimg2_Click()Label3.Visible=Falsecom1.ClearDimrsxlsAsNewADODB.Recordsetcd12.Filter=Excel(*.xls)|*.xls|(*.*)|*.*cd12.CancelError=Truecd12.DialogTitle=Excelcd12.CancelError=Truecd12.ShowOpenfn1=cd12.FileNameText1.Text=cd12.FileNameIfcn.State=adStateOpenThen'cnconn.CloseEndIfCallxlsconIffn1=ThenMsgBoxExcel!,vbInformation+vbOKOnly,EndIfSetrsxls=cn.OpenSchema(adSchemaTables)'ExcelDoUntilrsxls.EOFcom1.AddItemrsxls!table_name'combo1rsxls.MoveNextLooprsxls.CloseSetrsxls=NothingEndSub***********************************************PrivateSubcom1_Click()'DimiAsIntegerSetdg1.DataSource=Nothingdg1.RefreshLabel3.Visible=TrueDimoRSAsNewADODB.RecordsetoRS.OpenSelect*from[&com1.Text&],cn,adOpenStatic,adLockOptimistic'oRS.Updatei=oRS.RecordCountfn1count=oRS.Fields.CountLabel3.Caption=&i&'Label4.Caption=&oRS.Fields.Count&'Setdg1.DataSource=oRS'datagriddg1.Refreshcmd1.Enabled=TrueEndSub（2）Access，3。1）：（text1）；（img2）；（cd12）、（com1）；（msg1）Access（、、）；（cmd1）“”。2）PrivateSubcom1_Click()DimpAsIntegersr.Opencom1.Text,conn,adOpenKeyset,adLockOptimisticLabel3.Visible=TrueLabel3.Caption=&sr.Fields.Count&fncount=sr.Fields.Count3402010.3Withmsg1'msg1.Rows=sr.Fields.Count+1Forp=1Tosr.Fields.Count.TextMatrix(p,0)=p.TextMatrix(p,1)=sr.Fields(p-1).Name.TextMatrix(p,2)=sr.Fields(p-1).Type.TextMatrix(p,3)=sr.Fields(p-1).DefinedSizeNextpEndWithsr.CloseSetsr=Nothingcmd1.Enabled=TrueEndSub************************************************PrivateSubimg1_Click()DimrsAsNewADODB.Recordsetcd1.Filter=Access(*.mdb)|*.mdb|(*.*)|*.*cd1.CancelError=Truecd1.DialogTitle=Accesscd1.ShowOpenfn=cd1.FileNameText1.Text=fnIffn=ThenMsgBoxAccess!,vbInformation+vbOKOnlyEndIfIfconn.State=adStateOpenThen'connconn.Closecom1.ClearEndIfCallmdbconSetrs=conn.OpenSchema(adSchemaTables)'rsDoUntilrs.EOFIfLeft(rs!table_name,4)MSysThencom1.AddItemrs!table_name'combo1EndIfrs.MoveNextLooprs.CloseSetrs=NothingEndSub************************************************PrivateSubcmd1_Click()'DimiAsIntegerDimsAsIntegerDimrstAsNewADODB.RecordsetDimrsAsNewADODB.RecordsetIffn1count=fncountThen'rst.OpenSelect*from[&fexcel.com1.Text&],cn,adOpenDynamic'rs.Openselect*from&com1.Text&,conn,adOpenDynamic,adLockOptimistic'rs.MoveLasti=rst.RecordCountDoWhileNotrst.EOFOnErrorResumeNextrs.AddNewFors=0Tofn1count-1rs.Fields(s)=rst.Fields(s)'ExcelAccessNextsrs.MoveNextrst.MoveNexti=i-1Ifi=0Thenfaccess.Caption=！rs.UpdateMsgBox&rst.RecordCount&！,vbInformation,cmd2.Caption=Elsefaccess.Caption=，......EndIfLoopElseMsgBoxExcelAccess！,vbExclamation,EndIfrs.Closerst.CloseSetrs=NothingSetrst=Nothingcmd1.Enabled=FalseEndSub54。4412010.3（1）：（accesstxt）；（img2）；（cmd00）、（combo1）；（list1）Access；（cmdout）“”。（2）：PrivateSubimage1_Click()'Dimrs1AsNewADODB.Recordsetcmd00.Filter=Access(*.mdb)|*.mdb|(*.*)|*.*cmd00.CancelError=Truecmd00.DialogTitle=Accesscmd00.ShowOpenfn=cmd00.FileNameaccesstxt.Text=cmd00.FileNameIffn=ThenMsgBoxAccess!,vbInformation+vbOKOnlyEndIfIfconn.State=adStateOpenThenconn.Closecombo1.ClearEndIfCallmdbconSetrs1=conn.OpenSchema(adSchemaTables)DoUntilrs1.EOFIfLeft(rs1!table_name,4)MSysThen'combo1.AddItemrs1!table_nameEndIfrs1.MoveNextLooprs1.CloseSetrs1=NothingEndSub************************************************PrivateSubList1_ItemCheck(ItemAsInteger)Text1.Text=Text1.Text&List1.List(Item)&,'list1text1cmdout.Enabled=TrueEndSub************************************************PrivateSubcombo1_Click()'DimiAsIntegerDimsrsAsNewADODB.RecordsetList1.Clearsrs.Opencombo1.Text,conn,adOpenKeyset,adLockOptimistici=srs.Fields.CountFori=0Tosrs.Fields.Count-1List1.AddItemsrs.Fields(i).NameNextisrs.CloseSetsrs=NothingEndSub************************************************PrivateSubcmdout_Click()DimrstAsNewADODB.Recordsetrst.Openselect&Left(Trim(Text1.Text),Len(Trim(Text1.Text))-1)&from&combo1.Text&,conn,adOpenDynamic,adLockOptimisticDimxlsAppAsExcel.Application'ExcelDimxlsBookAsExcel.Workbook'DimxlsSheetAsExcel.Worksheet'Dimi,jAsLongSetxlsApp=CreateObject(Excel.Application)'Exce