[發問] 更新資料到ACCESS

本帖最後由 shadowming 於 2010-8-6 15:05 編輯

各位先進
我有一個EXCEL檔和ACCESS檔  檔名都是DDE
DDE.mdb裡有個 "類股資料" 資料表  欄位有 Date, A,B,C,D,E,F,G,H,I,J
我想把EXCEL的資料更新到ACCESS理
可是一直出現  "資料表不存在"
是哪裡寫錯了嗎?
請各位先進幫我解答一下
補附上資料庫

DDE.rar (457.54 KB)
Sub UpLago()  '更新類股資料到DB
Dim mSht As Worksheet
Dim mDic1 As Scripting.Dictionary
Dim mDic2 As Scripting.Dictionary
Dim ar, mSplit, mArr(), mArr2()
Dim mKey1, mItem1, mKey2, mItem2
Dim mCon As ADODB.Connection
Dim mRst As ADODB.Recordset
Dim conStr$, mSq2$, mPath$, mFilename$, mFile$
Dim k1%, k2%, i%, s%, r%, s1%, m%
Dim mTmp$, mTmp2$

Application.ScreenUpdating = False

Set mDic1 = CreateObject("Scripting.dictionary")
Set mSht = Worksheets(6)
With mSht
      ar = .Range("a3", "L" & .[a65536].End(xlUp).Row)
      For i = 1 To UBound(ar)
         mDic1(ar(i, 1)) = ar(i, 2) & "_" & ar(i, 3) & "_" & ar(i, 4) & "_" & ar(i, 5) & "_" & ar(i, 6) & "_" & ar(i, 7) & "_" & ar(i, 8) & "_" & ar(i, 9) & "_" & ar(i, 10) & "_" & ar(i, 11)
      Next

      mKey1 = mDic1.Keys
      mItem1 = mDic1.Items
      r = mDic1.Count

End With

mPath = ThisWorkbook.Path
mFilename = "DDE.mdb"
mFile = mPath & "\" & mFilename
conStr = "provider=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & mFile

Set mCon = New ADODB.Connection
With mCon
      .ConnectionString = conStr
      .Open
End With

mSq2 = "SELECT * FROM 類股資料"

Set mRst = New ADODB.Recordset
With mRst
      .ActiveConnection = mCon
      .LockType = adLockPessimistic
      .Source = mSq2
      .Open

End With

If mRst.EOF Then
      MsgBox "資料表不存在"
      Exit Sub
End If

With mRst
      mArr = .GetRows
End With

k2 = UBound(mArr, 2)
Set mDic2 = CreateObject("Scripting.Dictionary")
For s = 0 To k2
   mDic2(mArr(0, s)) = mArr(1, s) & "_" & mArr(2, s) & "_" & mArr(3, s) & "_" & mArr(4, s) & "_" & mArr(5, s) & "_" & mArr(6, s) & "_" & mArr(7, s) & "_" & mArr(8, s) & "_" & mArr(9, s) & "_" & mArr(10, s)
Next

For s = 1 To mDic1.Count - 1

      If Not mDic2.Exists(mKey1(s)) Then
         ReDim Preserve mArr2(m)
         mArr2(m) = mKey1(s) & "_" & mItem1(s)
         m = m + 1
      End If

Next
If m = 0 Then GoTo 10
For s = 0 To UBound(mArr2)
      mSplit = Split(mArr2(s), "_")
      On Error Resume Next
      With mRst
         .AddNew
         .Fields("Date") = mSplit(0)
         .Fields("A") = mSplit(1)
         .Fields("B") = mSplit(2)
         .Fields("C") = mSplit(3)
         .Fields("D") = mSplit(4)
         .Fields("E") = mSplit(5)
         .Fields("F") = mSplit(6)
         .Fields("G") = mSplit(7)
         .Fields("H") = mSplit(8)
         .Fields("I") = mSplit(9)
         .Fields("J") = mSplit(10)
         .Update

      End With

Next
10
mRst.Close
mCon.Close

Set mRst = Nothing
Set mCon = Nothing
End Sub