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

fjzjyan

我们长期从事于office、Visual Basic、Excel VBA+Access数据库开发等课程的教学工作。并以Visual Basic为开发工具，以SQL Sever（或Microsoft  Access）为后台数据库，用Microsoft  Excel  VBA开发输出的报表和表单为珠三角一些中小型企业开发多个生产管理、MRP系统。


我们有机整合了管理、教学、开发等经验，结合珠三角地区各公司学员的丰富有关物料、仓库、生产、工资、财务等案例来自行编写教材，并在《电脑报》发表文章十余篇，教学具有简明、实用、高效等特点。


如果你想提高EXCEL高级应用如VBA开发、ADO对象、SQL语句等相关应用，可联系我们(QQ:522519200 电话:13713090487  邮箱:fj_zjyan@163.com)，通过远程协助让你足不出户便学到你急需的知识。以住需要几个小时的工作仅用几行代码或语句瞬间即可完成。

[此贴子已经被作者于2007-5-17 11:24:11编辑过]

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