Office中国论坛/Access中国论坛

标题: [原创]Excel VBA+Access开发远程家教 [打印本页]

作者: fjzjyan 时间: 2007-1-19 07:39
标题: [原创]Excel VBA+Access开发远程家教
我们长期从事于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 时间: 2007-1-27 23:48
用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=Admin

assword=;
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

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)