[原创]Excel VBA+Access开发远程家教

charlieyoung

用excel打开access, 如果有密码如何写程序



Function uploadTOaccess_DeliveryStatus()
'**********************************
' upload the "urchase  Order  Details  Report(Delivery Status)"
' 用于将EXCEL表上传Tab_PO
' Macro recorded 2007-1-7 by charlie
' 由于分批入库，PO有重复
' 注意物料名称有？，造成格式不对，需要手工调整
' ado---Microsoft ActiveX Date Objects X.X Library
'**********************************
Dim conn As New ADODB.Connection, connstr As String, db As String, rs As New ADODB.Recordset
Dim rowexcel As Long
Dim lastrow As Long     '上传数据的最后一行
Dim k As Long
Dim rs1 As New ADODB.Recordset
Dim strSQL As String
Dim accesspath As String     'access文件的路径
Dim accessfile As String     'access文件名

'如果上传的表不对，则退出
If Cells(2, 2) <> "★★==  Purchase  Order  Details  Report(Delivery Status) ==★★" Then
    MsgBox "你上传的不对，应该是 PO Delivery Report"
    Exit Function
End If
   

accesspath = "d:\My Documents\Access\MRP\"
accessfile = "Noell MRP Data.mdb"
'db = "C:\adb2.mdb"
'db = "d:\My Documents\Access\0Study sample\adb2.mdb"
db = accesspath & accessfile
'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=d:\Northwind.mdb;User ID=Adminassword=;
connstr = "rovider=Microsoft.Jet.OLEDB.4.0;Data Source=" & db   '";;password=<qqq>"
conn.Open connstr ', , "qqq"   '";PWD=<qqq>"
rs.Open "select POitem,PO_Quantity,MaterialNo,UNIT,Project,Vendor_Name,POCrteDate,Purchaser,MRIsueDte,MRRequisiter,PODelrDate,Unitprice,UnitpriceCurrency,UnitQty,UnitofUnitQty,POAmount_RMB,Tax_code,Vendor_number from Tab_PO", conn, 1, 3
'添加
'Field1

'Find last row最后一行
'Sheets("Offer").Select
For k = 7 To 60000
    If ((Cells(k, 3) = "") And (Cells(k, 5) = "") And (Cells(k, 7)) = "") Then
        lastrow = k
        Exit For
    End If
Next k

    '对该行清理颜色
    Range("C1").Select
    Selection.ClearComments
    Range("C1").AddComment
    Range("C1").Comment.Visible = False
    Range("C1").Comment.Text Text:="Marked color cell is updated to Access" & Chr(10) & "" & Chr(10) & ""
    Columns("C:C").Select
    Selection.Interior.ColorIndex = xlNone
   
For rowexcel = 7 To lastrow         '数据从第三行开始
    '判断关键字段不重复,重复可以更新
    rs1.Open "select POitem,PO_Quantity,MaterialNo,UNIT,Project,Vendor_Name,POCrteDate,Purchaser,MRIsueDte,MRRequisiter,PODelrDate,Unitprice,UnitpriceCurrency,UnitQty,UnitofUnitQty,POAmount_RMB,Tax_code,Vendor_number from Tab_PO where Tab_PO.POitem='" & Cells(rowexcel, 3) & "-" & Cells(rowexcel, 5) & "'", conn, 1, 3
    If rs1.RecordCount <> 0 Then  '判断该值是否已经存在
                '过滤后对该值进行更新
                'rs1("POitem") 是关键字不能更改
                '已经有这个订单就进行更新
            If Cells(rowexcel, 3) <> "" Then
                'rs("POitem")   关键字
                'rs1("PO_Quantity") = Cells(rowexcel, 13)
                'rs1("UNIT") = Cells(rowexcel, 15)
                'rs1("MaterialNo") = Cells(rowexcel, 7)
                'rs1("Project") = Cells(rowexcel, 11)
                'rs1("Unitprice") = Cells(rowexcel, 17)
                'rs1("UnitpriceCurrency") = Cells(rowexcel, 18)
                'rs1("UnitQty") = Cells(rowexcel, 20)
                'rs1("UnitofUnitQty") = Cells(rowexcel, 21)
                'rs1("POAmount_RMB") = Cells(rowexcel, 23)
                'rs1("Tax_code") = Cells(rowexcel, 25)
                'rs1("Vendor_number") = Cells(rowexcel, 27)
                'rs1("Vendor_Name") = Cells(rowexcel, 29)
                'rs1("ActDlvrdQty") = Cells(rowexcel, 15)
                'rs1("POActDlvDate") = Cells(rowexcel, 35)
                'rs1("Vendor_number") = Cells(rowexcel, 9)
               
                'rs1.Update
                '更改数据上传行标记颜色
                'Cells(rowexcel, 3).Interior.ColorI