ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] §ó·s¸ê®Æ¨ìACCESS

[µo°Ý] §ó·s¸ê®Æ¨ìACCESS

¥»©«³Ì«á¥Ñ shadowming ©ó 2010-8-6 15:05 ½s¿è

¦U¦ì¥ý¶i
§Ú¦³¤@­ÓEXCELÀÉ©MACCESSÀÉ  ÀɦW³£¬ODDE
DDE.mdb¸Ì¦³­Ó "ÃþªÑ¸ê®Æ" ¸ê®Æªí  Äæ¦ì¦³ Date, A,B,C,D,E,F,G,H,I,J
§Ú·Q§âEXCELªº¸ê®Æ§ó·s¨ìACCESS²z
¥i¬O¤@ª½¥X²{  "¸ê®Æªí¤£¦s¦b"
¬O­þ¸Ì¼g¿ù¤F¶Ü?
½Ð¦U¦ì¥ý¶iÀ°§Ú¸Ñµª¤@¤U
¸Éªþ¤W¸ê®Æ®w
DDE.rar (457.54 KB)   
Sub UpLago()  '§ó·sÃþªÑ¸ê®Æ¨ì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 "¸ê®Æªí¤£¦s¦b"
        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

§Aªº¸ê®Æªí "ÃþªÑ¸ê®Æ" ¨S¦³¼Æ¾Ú

MsgBox "¸ê®Æªí¤£¦s¦b"
³o¥yÀ³¸Ó¬O
MsgBox "¸ê®Æªí¨S¦³¼Æ¾Ú"

¬d "¸ê®Æªí¤£¦s¦b"¥i¥H¥Î on erro goto... ©M  MsgBox Err.Description
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

If mRst.EOF Then
        MsgBox "¸ê®Æªí¤£¦s¦b"
        Exit Sub
    End If

mRst.EOF ¬O«ü¤w¹F¸ê®Æ¬y©³³¡
¦pkimbal©Ò»¡ ¤@¶}©l´N¹F¸ê®Æ¬y©³³¡ ¨º´N¬O«ü¨S¸ê®Æ~ ¤£¬O"¸ê®Æªí¤£¦s¦b"
­Y¬O§Ú¦^µª¡A¨Ï±zº¡·N¡A½Ð±zÅý§Úª¾¹D¡I                  
­Y¬O§Úªº¦^ÂСA±z¤´¦³¨ä¥L¨£¸Ñ¡A¤]½Ð±z¤£¶Þ«ü±Ð¡I

TOP

        ÀR«ä¦Û¦b : ¯¸¦b¥b¸ô¡A¤ñ¨«¨ì¥Ø¼Ð§ó¨¯­W¡C
ªð¦^¦Cªí ¤W¤@¥DÃD