请教各位大神,如何将excel中的表格数据自动存入ACCESS中,可随时刷新数据 5

用VBA编程实现比如这个,加个保存和刷新功能,存入Access数据库中... 用VBA编程实现
比如这个,加个保存和刷新功能,存入Access数据库中
展开
 我来答
daode1212
2014-05-13 · 超过53用户采纳过TA的回答
知道小有建树答主
回答量:176
采纳率:0%
帮助的人:144万
展开全部
Excel数据传入Access理容易些,这里给你Word数据传入Access的代码:
Sub TableToAccess()
'Created 2-18-99 by Helen Feddema
'Last modified 12-13-2001

On Error GoTo ErrorHandler

Dim strSiteName As String
Dim strIDName As String
Dim strIDValue As String
Dim strDBName As String
Dim DAO As New DAO.DBEngine
Dim dbs As Database
Dim rstOne As Recordset
Dim rstMany As Recordset
Dim wks As Workspace
Dim strDocsDir As String
Dim lngID As Long
Dim lngStartRows As Long
Dim lngRows As Long

'Pick up path to Documents folder from Registry
strDocsDir = System.PrivateProfileString("", _
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", _
"Personal")
strDBName = strDocsDir & "\Logons and IDs.mdb"
Debug.Print "DBName: " & strDBName
Set wks = DAO.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName)

Set rstOne = dbs.OpenRecordset("tblLogons")
Set rstMany = dbs.OpenRecordset("tblLogonValues")
Selection.HomeKey Unit:=wdStory

NextItem:
'Pick up site name from Heading 3 style
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 3")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
Selection.Find.Execute

If Selection.Find.Found = False Then
GoTo ErrorHandlerExit
End If

Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
strSiteName = Selection
Debug.Print "Site name: " & strSiteName
rstOne.AddNew
rstOne!SiteName = strSiteName
lngID = rstOne!ID
Debug.Print "ID: " & lngID
rstOne.Update

'Go to next table
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, _
Count:=1, Name:=""
lngStartRows = Selection.Information(wdMaximumNumberOfRows)

'Select current cell
Selection.MoveRight Unit:=wdCell
Selection.MoveLeft Unit:=wdCell

AddValues:
If Selection.Type = wdSelectionIP Then GoTo NextItem
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

'Save ID name and value to variables
strIDName = Selection
Debug.Print "ID name: " & strIDName
Selection.MoveRight Unit:=wdCell
strIDValue = Selection
Debug.Print "ID value: " & strIDValue

'Write ID name and value to Many table
With rstMany
.AddNew
!ID = lngID
!ItemName = strIDName
!ItemValue = strIDValue
.Update
End With

'Check whether still in table, and go to next heading if not
Selection.MoveRight Unit:=wdCell
lngRows = Selection.Information(wdMaximumNumberOfRows)
Debug.Print "Start rows: " & lngStartRows & vbCrLf & "Rows: " & lngRows
If lngRows = lngStartRows Then
If Selection.Information(wdWithInTable) = True Then
GoTo AddValues
Else
GoTo NextItem
End If
End If

ErrorHandlerExit:
rstOne.Close
rstMany.Close
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; error message: " & Err.Description
Resume ErrorHandlerExit

End Sub
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式