0
私のコードで何がうまくいかないのか分かりません。私はVBAを使用してスプレッドシートをAccessテーブルにリンクしようとしています。コードにエラーはありませんが、テーブルは更新されていません。私は答えを探しているのではなく、正しい方向に振っています。ここでLinkeエクセルテーブルVBAにアクセス
は、コードは次のとおりです。
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