Linke Excel访问表VBA

时间:2016-05-23 22:02:28

标签: excel vba access-vba access

我无法弄清楚我的代码出了什么问题。我正在尝试使用VBA将电子表格链接到Access表。代码中没有错误,但表没有更新。我不是在寻找答案,而是在正确的方向上轻推。

以下是代码:

Option Compare Database

Private Sub Command0_Click()
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Dim pathXls As String

pathXls = CurrentProject.Path & "\Week7DVDupdate.xlsx"
Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject(pathXls)
Set xlsht = xlWrkBk.Worksheets(1)

Dim DVD_Number As String
Dim Movie_Title As String
Dim Year_Released As String
Dim Disk_Type As String
Dim Quantity_in_Stock As Integer
Dim Number_Rented As Integer
Dim Number_of_Times_Rented As Integer

flag = True
Dim i As Integer
i = 2
Do While flag = True
    DVD_Number = xlsht.Cells(i, "A")
    Movie_Title = xlsht.Cells(i, "B")
    Year_Released = xlsht.Cells(i, "C")
    Disk_Type = xlsht.Cells(i, "D")
    Quantity_in_Stock = xlsht.Cells(i, "E")
    Number_Rented = xlsht.Cells(i, "F")
    Number_of_Times_Rented = xlsht.Cells(i, "G")

    If Title = "" Then
        flag = False
    End If

    If flag = True Then

        Dim rs As New ADODB.Recordset
        Dim strSql As String

        strSql = "SELECT * FROM DVD;"
        rs.Open strSql, CurrentProject.Connection
        Dim exist As String
        exist = False

        Do While Not rs.EOF
            If rs!DVD_Number = DVD_Number And rs!Movie_Title = Movie_Title 
    Then
            exist = True
        vEnd If
        rs.MoveNext
   v Loop
    rs.Close

    If exist = False Then
        strSql = "INSERT INTO DVD ( DVD_Number, Movie_Title, Year_Released, Disk_Type, Quantity_in_Stock, Number_Rented, Number_of_Times_Rented ) " & _
            "VALUES('" & DVD_Number & "','" & MovieTitle & "','" & Year_Released & "','" & Disk_Type & "','" & Quantity_in_Stock & "','" & Number_Rented & "','" & Number_of_Times_Rented & "')"
            CurrentProject.Connection.Execute strSql, lngKt
            ExecuteADO = lngKt
        End If

        Set rs = Nothing
    End If
    i = i + 1
Loop
MsgBox ("Media Link updated")
End Sub

1 个答案:

答案 0 :(得分:0)

如果您想将数据从Excel传输到Access,您应该尝试执行DoCmd.TransferSpreadsheet或类似的操作:

SELECT *
FROM [Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Week7DVDupdate.xlsx;Extended Properties="Excel 12.0 Xml;HDR=YES";].SheetName

您可能需要将连接字符串更改为更合适的内容,请参阅此处:http://www.connectionstrings.com/excel/